diff options
author | Rutger Broekhoff | 2025-07-07 21:52:08 +0200 |
---|---|---|
committer | Rutger Broekhoff | 2025-07-07 21:52:08 +0200 |
commit | ba61dfd69504ec6263a9dee9931d93adeb6f3142 (patch) | |
tree | d6c9b78e50eeab24e0c1c09ab45909a6ae3fd5db | |
download | verified-dyn-lang-interp-ba61dfd69504ec6263a9dee9931d93adeb6f3142.tar.gz verified-dyn-lang-interp-ba61dfd69504ec6263a9dee9931d93adeb6f3142.zip |
Initialize repository
538 files changed, 16716 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..00ce93e --- /dev/null +++ b/.gitignore | |||
@@ -0,0 +1,22 @@ | |||
1 | *.aux | ||
2 | *.glob | ||
3 | *.vio | ||
4 | *.vo | ||
5 | *.vok | ||
6 | *.vos | ||
7 | .CoqMakefile.d | ||
8 | .Makefile.coq.d | ||
9 | .direnv | ||
10 | .lia.cache | ||
11 | Makefile.coq | ||
12 | Makefile.coq.conf | ||
13 | *#*.v# | ||
14 | *~ | ||
15 | _build/ | ||
16 | _coverage/ | ||
17 | _opam/ | ||
18 | result | ||
19 | mininix_history | ||
20 | .vscode/ | ||
21 | .envrc | ||
22 | mininix.install | ||
diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..9ed4c26 --- /dev/null +++ b/.ocamlformat | |||
@@ -0,0 +1 @@ | |||
version = 0.27.0 | |||
diff --git a/.ocamlformat-ignore b/.ocamlformat-ignore new file mode 100644 index 0000000..fb55689 --- /dev/null +++ b/.ocamlformat-ignore | |||
@@ -0,0 +1 @@ | |||
lib/mininix/extraction.* | |||
@@ -0,0 +1,564 @@ | |||
1 | License information for this artifact | ||
2 | ===================================== | ||
3 | |||
4 | This artifact consists of a few parts. We choose to license most of | ||
5 | our code under the 3-clause BSD license (SPDX: BSD-3-Clause), with an | ||
6 | exception of the Nix test suite that we have adopted, which remains | ||
7 | licensed under LGPL 2.1 (SPDX: LGPL-2.1-or-later). | ||
8 | |||
9 | Specifically: | ||
10 | - The following files in lib/nix/ are derived from nixformat [1] by | ||
11 | Denis Korzunov: | ||
12 | lexer.ml, nix.ml, parser.mly, printer.ml and types.ml | ||
13 | nixformat is licensed under ISC (SPDX: ISC). For consistency, we | ||
14 | choose to relicense these files under the 3-clause BSD license (as | ||
15 | it subsumes the ISC license). We also include a copy of the ISC | ||
16 | license as required. | ||
17 | - The files in test/testdata/ come from Nix [2] and remain licensed | ||
18 | under version 2.1 of the LGPL license. We also include a copy of | ||
19 | this license below. The only exception here is the file | ||
20 | test/testdata/importdef.sexp | ||
21 | which was created by us (and is therefore licensed under the 3-clause BSD | ||
22 | license). | ||
23 | - Any files not described by the preceding items is licensed under the | ||
24 | 3-clause BSD license. | ||
25 | |||
26 | [1]: https://github.com/d2km/nixformat | ||
27 | [2]: https://github.com/NixOs/nix | ||
28 | |||
29 | |||
30 | The 3-clause BSD license (BSD-3-Clause) | ||
31 | --------------------------------------- | ||
32 | |||
33 | Redistribution and use in source and binary forms, with or without | ||
34 | modification, are permitted provided that the following conditions are | ||
35 | met: | ||
36 | |||
37 | 1. Redistributions of source code must retain the above copyright | ||
38 | notice, this list of conditions and the following disclaimer. | ||
39 | 2. Redistributions in binary form must reproduce the above | ||
40 | copyright notice, this list of conditions and the following | ||
41 | disclaimer in the documentation and/or other materials provided | ||
42 | with the distribution. | ||
43 | 3. Neither the name of the copyright holder nor the names of its | ||
44 | contributors may be used to endorse or promote products derived | ||
45 | from this software without specific prior written permission. | ||
46 | |||
47 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS | ||
48 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT | ||
49 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR | ||
50 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT | ||
51 | HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, | ||
52 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT | ||
53 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, | ||
54 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY | ||
55 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT | ||
56 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE | ||
57 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. | ||
58 | |||
59 | |||
60 | The ISC license (ISC) | ||
61 | --------------------- | ||
62 | |||
63 | Permission to use, copy, modify, and /or distribute this software for | ||
64 | any purpose with or without fee is hereby granted, provided that the | ||
65 | above copyright notice and this permission notice appear in all | ||
66 | copies. | ||
67 | |||
68 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL | ||
69 | WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED | ||
70 | WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE | ||
71 | AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL | ||
72 | DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR | ||
73 | PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER | ||
74 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR | ||
75 | PERFORMANCE OF THIS SOFTWARE. | ||
76 | |||
77 | |||
78 | Version 2.1 of the LGPL license (LGPL-2.1-or-later) | ||
79 | --------------------------------------------------- | ||
80 | |||
81 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. | ||
82 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | ||
83 | |||
84 | Everyone is permitted to copy and distribute verbatim copies of this | ||
85 | license document, but changing it is not allowed. | ||
86 | |||
87 | [This is the first released version of the Lesser GPL. It also counts | ||
88 | as the successor of the GNU Library Public License, version 2, hence | ||
89 | the version number 2.1.] | ||
90 | |||
91 | Preamble | ||
92 | |||
93 | The licenses for most software are designed to take away your freedom | ||
94 | to share and change it. By contrast, the GNU General Public Licenses | ||
95 | are intended to guarantee your freedom to share and change free | ||
96 | software--to make sure the software is free for all its users. | ||
97 | |||
98 | This license, the Lesser General Public License, applies to some | ||
99 | specially designated software packages--typically libraries--of the | ||
100 | Free Software Foundation and other authors who decide to use it. You | ||
101 | can use it too, but we suggest you first think carefully about whether | ||
102 | this license or the ordinary General Public License is the better | ||
103 | strategy to use in any particular case, based on the explanations | ||
104 | below. | ||
105 | |||
106 | When we speak of free software, we are referring to freedom of use, | ||
107 | not price. Our General Public Licenses are designed to make sure that | ||
108 | you have the freedom to distribute copies of free software (and charge | ||
109 | for this service if you wish); that you receive source code or can get | ||
110 | it if you want it; that you can change the software and use pieces of | ||
111 | it in new free programs; and that you are informed that you can do | ||
112 | these things. | ||
113 | |||
114 | To protect your rights, we need to make restrictions that forbid | ||
115 | distributors to deny you these rights or to ask you to surrender these | ||
116 | rights. These restrictions translate to certain responsibilities for | ||
117 | you if you distribute copies of the library or if you modify it. | ||
118 | |||
119 | For example, if you distribute copies of the library, whether gratis | ||
120 | or for a fee, you must give the recipients all the rights that we gave | ||
121 | you. You must make sure that they, too, receive or can get the source | ||
122 | code. If you link other code with the library, you must provide | ||
123 | complete object files to the recipients, so that they can relink them | ||
124 | with the library after making changes to the library and recompiling | ||
125 | it. And you must show them these terms so they know their rights. | ||
126 | |||
127 | We protect your rights with a two-step method: (1) we copyright the | ||
128 | library, and (2) we offer you this license, which gives you legal | ||
129 | permission to copy, distribute and/or modify the library. | ||
130 | |||
131 | To protect each distributor, we want to make it very clear that there | ||
132 | is no warranty for the free library. Also, if the library is modified | ||
133 | by someone else and passed on, the recipients should know that what | ||
134 | they have is not the original version, so that the original author's | ||
135 | reputation will not be affected by problems that might be introduced | ||
136 | by others. | ||
137 | |||
138 | Finally, software patents pose a constant threat to the existence of | ||
139 | any free program. We wish to make sure that a company cannot | ||
140 | effectively restrict the users of a free program by obtaining a | ||
141 | restrictive license from a patent holder. Therefore, we insist that | ||
142 | any patent license obtained for a version of the library must be | ||
143 | consistent with the full freedom of use specified in this license. | ||
144 | |||
145 | Most GNU software, including some libraries, is covered by the | ||
146 | ordinary GNU General Public License. This license, the GNU Lesser | ||
147 | General Public License, applies to certain designated libraries, and | ||
148 | is quite different from the ordinary General Public License. We use | ||
149 | this license for certain libraries in order to permit linking those | ||
150 | libraries into non-free programs. | ||
151 | |||
152 | When a program is linked with a library, whether statically or using a | ||
153 | shared library, the combination of the two is legally speaking a | ||
154 | combined work, a derivative of the original library. The ordinary | ||
155 | General Public License therefore permits such linking only if the | ||
156 | entire combination fits its criteria of freedom. The Lesser General | ||
157 | Public License permits more lax criteria for linking other code with | ||
158 | the library. | ||
159 | |||
160 | We call this license the "Lesser" General Public License because it | ||
161 | does Less to protect the user's freedom than the ordinary General | ||
162 | Public License. It also provides other free software developers Less | ||
163 | of an advantage over competing non-free programs. These disadvantages | ||
164 | are the reason we use the ordinary General Public License for many | ||
165 | libraries. However, the Lesser license provides advantages in certain | ||
166 | special circumstances. | ||
167 | |||
168 | For example, on rare occasions, there may be a special need to | ||
169 | encourage the widest possible use of a certain library, so that it | ||
170 | becomes a de-facto standard. To achieve this, non-free programs must | ||
171 | be allowed to use the library. A more frequent case is that a free | ||
172 | library does the same job as widely used non-free libraries. In this | ||
173 | case, there is little to gain by limiting the free library to free | ||
174 | software only, so we use the Lesser General Public License. | ||
175 | |||
176 | In other cases, permission to use a particular library in non-free | ||
177 | programs enables a greater number of people to use a large body of | ||
178 | free software. For example, permission to use the GNU C Library in | ||
179 | non-free programs enables many more people to use the whole GNU | ||
180 | operating system, as well as its variant, the GNU/Linux operating | ||
181 | system. | ||
182 | |||
183 | Although the Lesser General Public License is Less protective of the | ||
184 | users' freedom, it does ensure that the user of a program that is | ||
185 | linked with the Library has the freedom and the wherewithal to run | ||
186 | that program using a modified version of the Library. | ||
187 | |||
188 | The precise terms and conditions for copying, distribution and | ||
189 | modification follow. Pay close attention to the difference between a | ||
190 | "work based on the library" and a "work that uses the library". The | ||
191 | former contains code derived from the library, whereas the latter must | ||
192 | be combined with the library in order to run. | ||
193 | |||
194 | GNU LESSER GENERAL PUBLIC LICENSE | ||
195 | |||
196 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION | ||
197 | |||
198 | 0. This License Agreement applies to any software library or | ||
199 | other program which contains a notice placed by the copyright | ||
200 | holder or other authorized party saying it may be distributed | ||
201 | under the terms of this Lesser General Public License (also | ||
202 | called "this License"). Each licensee is addressed as "you". | ||
203 | |||
204 | A "library" means a collection of software functions and/or | ||
205 | data prepared so as to be conveniently linked with application | ||
206 | programs (which use some of those functions and data) to form | ||
207 | executables. | ||
208 | |||
209 | The "Library", below, refers to any such software library or | ||
210 | work which has been distributed under these terms. A "work | ||
211 | based on the Library" means either the Library or any | ||
212 | derivative work under copyright law: that is to say, a work | ||
213 | containing the Library or a portion of it, either verbatim or | ||
214 | with modifications and/or translated straightforwardly into | ||
215 | another language. (Hereinafter, translation is included | ||
216 | without limitation in the term "modification".) | ||
217 | |||
218 | "Source code" for a work means the preferred form of the work | ||
219 | for making modifications to it. For a library, complete source | ||
220 | code means all the source code for all modules it contains, | ||
221 | plus any associated interface definition files, plus the | ||
222 | scripts used to control compilation and installation of the | ||
223 | library. | ||
224 | |||
225 | Activities other than copying, distribution and modification | ||
226 | are not covered by this License; they are outside its scope. | ||
227 | The act of running a program using the Library is not | ||
228 | restricted, and output from such a program is covered only if | ||
229 | its contents constitute a work based on the Library | ||
230 | (independent of the use of the Library in a tool for writing | ||
231 | it). Whether that is true depends on what the Library does and | ||
232 | what the program that uses the Library does. 1. You may copy | ||
233 | and distribute verbatim copies of the Library's complete | ||
234 | source code as you receive it, in any medium, provided that | ||
235 | you conspicuously and appropriately publish on each copy an | ||
236 | appropriate copyright notice and disclaimer of warranty; keep | ||
237 | intact all the notices that refer to this License and to the | ||
238 | absence of any warranty; and distribute a copy of this License | ||
239 | along with the Library. | ||
240 | |||
241 | You may charge a fee for the physical act of transferring a | ||
242 | copy, and you may at your option offer warranty protection in | ||
243 | exchange for a fee. | ||
244 | |||
245 | 2. You may modify your copy or copies of the Library or any | ||
246 | portion of it, thus forming a work based on the Library, and | ||
247 | copy and distribute such modifications or work under the terms | ||
248 | of Section 1 above, provided that you also meet all of these | ||
249 | conditions: | ||
250 | |||
251 | a) The modified work must itself be a software library. | ||
252 | b) You must cause the files modified to carry prominent | ||
253 | notices stating that you changed the files and the date of | ||
254 | any change. | ||
255 | c) You must cause the whole of the work to be licensed at no | ||
256 | charge to all third parties under the terms of this | ||
257 | License. | ||
258 | d) If a facility in the modified Library refers to a function | ||
259 | or a table of data to be supplied by an application | ||
260 | program that uses the facility, other than as an argument | ||
261 | passed when the facility is invoked, then you must make a | ||
262 | good faith effort to ensure that, in the event an | ||
263 | application does not supply such function or table, the | ||
264 | facility still operates, and performs whatever part of its | ||
265 | purpose remains meaningful. | ||
266 | |||
267 | (For example, a function in a library to compute square roots | ||
268 | has a purpose that is entirely well-defined independent of the | ||
269 | application. Therefore, Subsection 2d requires that any | ||
270 | application-supplied function or table used by this function | ||
271 | must be optional: if the application does not supply it, the | ||
272 | square root function must still compute square roots.) | ||
273 | |||
274 | These requirements apply to the modified work as a whole. If | ||
275 | identifiable sections of that work are not derived from the | ||
276 | Library, and can be reasonably considered independent and | ||
277 | separate works in themselves, then this License, and its | ||
278 | terms, do not apply to those sections when you distribute them | ||
279 | as separate works. But when you distribute the same sections | ||
280 | as part of a whole which is a work based on the Library, the | ||
281 | distribution of the whole must be on the terms of this | ||
282 | License, whose permissions for other licensees extend to the | ||
283 | entire whole, and thus to each and every part regardless of | ||
284 | who wrote it. | ||
285 | |||
286 | Thus, it is not the intent of this section to claim rights or | ||
287 | contest your rights to work written entirely by you; rather, | ||
288 | the intent is to exercise the right to control the | ||
289 | distribution of derivative or collective works based on the | ||
290 | Library. | ||
291 | |||
292 | In addition, mere aggregation of another work not based on the | ||
293 | Library with the Library (or with a work based on the Library) | ||
294 | on a volume of a storage or distribution medium does not bring | ||
295 | the other work under the scope of this License. | ||
296 | |||
297 | 3. You may opt to apply the terms of the ordinary GNU General | ||
298 | Public License instead of this License to a given copy of the | ||
299 | Library. To do this, you must alter all the notices that refer | ||
300 | to this License, so that they refer to the ordinary GNU | ||
301 | General Public License, version 2, instead of to this License. | ||
302 | (If a newer version than version 2 of the ordinary GNU General | ||
303 | Public License has appeared, then you can specify that version | ||
304 | instead if you wish.) Do not make any other change in these | ||
305 | notices. | ||
306 | |||
307 | Once this change is made in a given copy, it is irreversible | ||
308 | for that copy, so the ordinary GNU General Public License | ||
309 | applies to all subsequent copies and derivative works made | ||
310 | from that copy. | ||
311 | |||
312 | This option is useful when you wish to copy part of the code | ||
313 | of the Library into a program that is not a library. | ||
314 | |||
315 | 4. You may copy and distribute the Library (or a portion or | ||
316 | derivative of it, under Section 2) in object code or | ||
317 | executable form under the terms of Sections 1 and 2 above | ||
318 | provided that you accompany it with the complete corresponding | ||
319 | machine-readable source code, which must be distributed under | ||
320 | the terms of Sections 1 and 2 above on a medium customarily | ||
321 | used for software interchange. | ||
322 | |||
323 | If distribution of object code is made by offering access to | ||
324 | copy from a designated place, then offering equivalent access | ||
325 | to copy the source code from the same place satisfies the | ||
326 | requirement to distribute the source code, even though third | ||
327 | parties are not compelled to copy the source along with the | ||
328 | object code. | ||
329 | |||
330 | 5. A program that contains no derivative of any portion of the | ||
331 | Library, but is designed to work with the Library by being | ||
332 | compiled or linked with it, is called a "work that uses the | ||
333 | Library". Such a work, in isolation, is not a derivative work | ||
334 | of the Library, and therefore falls outside the scope of this | ||
335 | License. | ||
336 | |||
337 | However, linking a "work that uses the Library" with the | ||
338 | Library creates an executable that is a derivative of the | ||
339 | Library (because it contains portions of the Library), rather | ||
340 | than a "work that uses the library". The executable is | ||
341 | therefore covered by this License. Section 6 states terms for | ||
342 | distribution of such executables. | ||
343 | |||
344 | When a "work that uses the Library" uses material from a | ||
345 | header file that is part of the Library, the object code for | ||
346 | the work may be a derivative work of the Library even though | ||
347 | the source code is not. Whether this is true is especially | ||
348 | significant if the work can be linked without the Library, or | ||
349 | if the work is itself a library. The threshold for this to be | ||
350 | true is not precisely defined by law. | ||
351 | |||
352 | If such an object file uses only numerical parameters, data | ||
353 | structure layouts and accessors, and small macros and small | ||
354 | inline functions (ten lines or less in length), then the use | ||
355 | of the object file is unrestricted, regardless of whether it | ||
356 | is legally a derivative work. (Executables containing this | ||
357 | object code plus portions of the Library will still fall under | ||
358 | Section 6.) | ||
359 | |||
360 | Otherwise, if the work is a derivative of the Library, you may | ||
361 | distribute the object code for the work under the terms of | ||
362 | Section 6. Any executables containing that work also fall | ||
363 | under Section 6, whether or not they are linked directly with | ||
364 | the Library itself. | ||
365 | |||
366 | 6. As an exception to the Sections above, you may also combine or | ||
367 | link a "work that uses the Library" with the Library to | ||
368 | produce a work containing portions of the Library, and | ||
369 | distribute that work under terms of your choice, provided that | ||
370 | the terms permit modification of the work for the customer's | ||
371 | own use and reverse engineering for debugging such | ||
372 | modifications. | ||
373 | |||
374 | You must give prominent notice with each copy of the work that | ||
375 | the Library is used in it and that the Library and its use are | ||
376 | covered by this License. You must supply a copy of this | ||
377 | License. If the work during execution displays copyright | ||
378 | notices, you must include the copyright notice for the Library | ||
379 | among them, as well as a reference directing the user to the | ||
380 | copy of this License. Also, you must do one of these things: | ||
381 | |||
382 | a) Accompany the work with the complete corresponding | ||
383 | machine-readable source code for the Library including | ||
384 | whatever changes were used in the work (which must be | ||
385 | distributed under Sections 1 and 2 above); and, if the | ||
386 | work is an executable linked with the Library, with the | ||
387 | complete machine-readable "work that uses the Library", as | ||
388 | object code and/or source code, so that the user can | ||
389 | modify the Library and then relink to produce a modified | ||
390 | executable containing the modified Library. (It is | ||
391 | understood that the user who changes the contents of | ||
392 | definitions files in the Library will not necessarily be | ||
393 | able to recompile the application to use the modified | ||
394 | definitions.) | ||
395 | b) Use a suitable shared library mechanism for linking with | ||
396 | the Library. A suitable mechanism is one that (1) uses at | ||
397 | run time a copy of the library already present on the | ||
398 | user's computer system, rather than copying library | ||
399 | functions into the executable, and (2) will operate | ||
400 | properly with a modified version of the library, if the | ||
401 | user installs one, as long as the modified version is | ||
402 | interface-compatible with the version that the work was | ||
403 | made with. | ||
404 | c) Accompany the work with a written offer, valid for at | ||
405 | least three years, to give the same user the materials | ||
406 | specified in Subsection 6a, above, for a charge no more | ||
407 | than the cost of performing this distribution. | ||
408 | d) If distribution of the work is made by offering access to | ||
409 | copy from a designated place, offer equivalent access to | ||
410 | copy the above specified materials from the same place. | ||
411 | e) Verify that the user has already received a copy of these | ||
412 | materials or that you have already sent this user a copy. | ||
413 | |||
414 | For an executable, the required form of the "work that uses | ||
415 | the Library" must include any data and utility programs needed | ||
416 | for reproducing the executable from it. However, as a special | ||
417 | exception, the materials to be distributed need not include | ||
418 | anything that is normally distributed (in either source or | ||
419 | binary form) with the major components (compiler, kernel, and | ||
420 | so on) of the operating system on which the executable runs, | ||
421 | unless that component itself accompanies the executable. | ||
422 | |||
423 | It may happen that this requirement contradicts the license | ||
424 | restrictions of other proprietary libraries that do not | ||
425 | normally accompany the operating system. Such a contradiction | ||
426 | means you cannot use both them and the Library together in an | ||
427 | executable that you distribute. | ||
428 | |||
429 | 7. You may place library facilities that are a work based on the | ||
430 | Library side-by-side in a single library together with other | ||
431 | library facilities not covered by this License, and distribute | ||
432 | such a combined library, provided that the separate | ||
433 | distribution of the work based on the Library and of the other | ||
434 | library facilities is otherwise permitted, and provided that | ||
435 | you do these two things: | ||
436 | |||
437 | a) Accompany the combined library with a copy of the same | ||
438 | work based on the Library, uncombined with any other | ||
439 | library facilities. This must be distributed under the | ||
440 | terms of the Sections above. | ||
441 | b) Give prominent notice with the combined library of the | ||
442 | fact that part of it is a work based on the Library, and | ||
443 | explaining where to find the accompanying uncombined form | ||
444 | of the same work. | ||
445 | |||
446 | 8. You may not copy, modify, sublicense, link with, or distribute | ||
447 | the Library except as expressly provided under this License. | ||
448 | Any attempt otherwise to copy, modify, sublicense, link with, | ||
449 | or distribute the Library is void, and will automatically | ||
450 | terminate your rights under this License. However, parties who | ||
451 | have received copies, or rights, from you under this License | ||
452 | will not have their licenses terminated so long as such | ||
453 | parties remain in full compliance. | ||
454 | |||
455 | 9. You are not required to accept this License, since you have | ||
456 | not signed it. However, nothing else grants you permission to | ||
457 | modify or distribute the Library or its derivative works. | ||
458 | These actions are prohibited by law if you do not accept this | ||
459 | License. Therefore, by modifying or distributing the Library | ||
460 | (or any work based on the Library), you indicate your | ||
461 | acceptance of this License to do so, and all its terms and | ||
462 | conditions for copying, distributing or modifying the Library | ||
463 | or works based on it. | ||
464 | |||
465 | 10. Each time you redistribute the Library (or any work based on | ||
466 | the Library), the recipient automatically receives a license | ||
467 | from the original licensor to copy, distribute, link with or | ||
468 | modify the Library subject to these terms and conditions. You | ||
469 | may not impose any further restrictions on the recipients' | ||
470 | exercise of the rights granted herein. You are not responsible | ||
471 | for enforcing compliance by third parties with this License. | ||
472 | |||
473 | 11. If, as a consequence of a court judgment or allegation of | ||
474 | patent infringement or for any other reason (not limited to | ||
475 | patent issues), conditions are imposed on you (whether by | ||
476 | court order, agreement or otherwise) that contradict the | ||
477 | conditions of this License, they do not excuse you from the | ||
478 | conditions of this License. If you cannot distribute so as to | ||
479 | satisfy simultaneously your obligations under this License and | ||
480 | any other pertinent obligations, then as a consequence you may | ||
481 | not distribute the Library at all. For example, if a patent | ||
482 | license would not permit royalty-free redistribution of the | ||
483 | Library by all those who receive copies directly or indirectly | ||
484 | through you, then the only way you could satisfy both it and | ||
485 | this License would be to refrain entirely from distribution of | ||
486 | the Library. | ||
487 | |||
488 | If any portion of this section is held invalid or | ||
489 | unenforceable under any particular circumstance, the balance | ||
490 | of the section is intended to apply, and the section as a | ||
491 | whole is intended to apply in other circumstances. | ||
492 | |||
493 | It is not the purpose of this section to induce you to | ||
494 | infringe any patents or other property right claims or to | ||
495 | contest validity of any such claims; this section has the sole | ||
496 | purpose of protecting the integrity of the free software | ||
497 | distribution system which is implemented by public license | ||
498 | practices. Many people have made generous contributions to the | ||
499 | wide range of software distributed through that system in | ||
500 | reliance on consistent application of that system; it is up to | ||
501 | the author/donor to decide if he or she is willing to | ||
502 | distribute software through any other system and a licensee | ||
503 | cannot impose that choice. | ||
504 | |||
505 | This section is intended to make thoroughly clear what is | ||
506 | believed to be a consequence of the rest of this License. | ||
507 | |||
508 | 12. If the distribution and/or use of the Library is restricted in | ||
509 | certain countries either by patents or by copyrighted | ||
510 | interfaces, the original copyright holder who places the | ||
511 | Library under this License may add an explicit geographical | ||
512 | distribution limitation excluding those countries, so that | ||
513 | distribution is permitted only in or among countries not thus | ||
514 | excluded. In such case, this License incorporates the | ||
515 | limitation as if written in the body of this License. | ||
516 | |||
517 | 13. The Free Software Foundation may publish revised and/or new | ||
518 | versions of the Lesser General Public License from time to | ||
519 | time. Such new versions will be similar in spirit to the | ||
520 | present version, but may differ in detail to address new | ||
521 | problems or concerns. | ||
522 | |||
523 | Each version is given a distinguishing version number. If the | ||
524 | Library specifies a version number of this License which | ||
525 | applies to it and "any later version", you have the option of | ||
526 | following the terms and conditions either of that version or | ||
527 | of any later version published by the Free Software | ||
528 | Foundation. If the Library does not specify a license version | ||
529 | number, you may choose any version ever published by the Free | ||
530 | Software Foundation. | ||
531 | |||
532 | 14. If you wish to incorporate parts of the Library into other | ||
533 | free programs whose distribution conditions are incompatible | ||
534 | with these, write to the author to ask for permission. For | ||
535 | software which is copyrighted by the Free Software Foundation, | ||
536 | write to the Free Software Foundation; we sometimes make | ||
537 | exceptions for this. Our decision will be guided by the two | ||
538 | goals of preserving the free status of all derivatives of our | ||
539 | free software and of promoting the sharing and reuse of | ||
540 | software generally. | ||
541 | |||
542 | NO WARRANTY | ||
543 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO | ||
544 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY | ||
545 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE | ||
546 | COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS | ||
547 | IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, | ||
548 | INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF | ||
549 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE | ||
550 | ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY | ||
551 | IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME | ||
552 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. | ||
553 | |||
554 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN | ||
555 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY | ||
556 | MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE | ||
557 | LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, | ||
558 | INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR | ||
559 | INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO | ||
560 | LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES | ||
561 | SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY | ||
562 | TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR | ||
563 | OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH | ||
564 | DAMAGES. | ||
diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..ac8dba0 --- /dev/null +++ b/Makefile | |||
@@ -0,0 +1,55 @@ | |||
1 | # Default target | ||
2 | all: Makefile.coq | ||
3 | +@$(MAKE) -f Makefile.coq all | ||
4 | .PHONY: all | ||
5 | |||
6 | # Permit local customization | ||
7 | -include Makefile.local | ||
8 | |||
9 | # Forward most targets to Coq makefile (with some trick to make this phony) | ||
10 | %: Makefile.coq phony | ||
11 | @#echo "Forwarding $@" | ||
12 | +@$(MAKE) -f Makefile.coq $@ | ||
13 | phony: ; | ||
14 | .PHONY: phony | ||
15 | |||
16 | clean: Makefile.coq | ||
17 | +@$(MAKE) -f Makefile.coq clean | ||
18 | @# Make sure not to enter the `_opam` folder. | ||
19 | find [a-z]*/ \( -name "*.d" -o -name "*.vo" -o -name "*.vo[sk]" -o -name "*.aux" -o -name "*.cache" -o -name "*.glob" -o -name "*.vio" \) -print -delete || true | ||
20 | rm -f Makefile.coq .lia.cache builddep/* | ||
21 | .PHONY: clean | ||
22 | |||
23 | # Create Coq Makefile. | ||
24 | Makefile.coq: _CoqProject Makefile | ||
25 | "$(COQBIN)coq_makefile" -f _CoqProject -o Makefile.coq $(EXTRA_COQFILES) | ||
26 | |||
27 | # Install build-dependencies | ||
28 | OPAMFILES=$(wildcard *.opam) | ||
29 | BUILDDEPFILES=$(addsuffix -builddep.opam, $(addprefix builddep/,$(basename $(OPAMFILES)))) | ||
30 | |||
31 | builddep/%-builddep.opam: %.opam Makefile | ||
32 | @echo "# Creating builddep package for $<." | ||
33 | @mkdir -p builddep | ||
34 | @sed <$< -E 's/^(build|install|remove):.*/\1: []/; s/"(.*)"(.*= *version.*)$$/"\1-builddep"\2/;' >$@ | ||
35 | |||
36 | builddep-opamfiles: $(BUILDDEPFILES) | ||
37 | .PHONY: builddep-opamfiles | ||
38 | |||
39 | builddep: builddep-opamfiles | ||
40 | @# We want opam to not just install the build-deps now, but to also keep satisfying these | ||
41 | @# constraints. Otherwise, `opam upgrade` may well update some packages to versions | ||
42 | @# that are incompatible with our build requirements. | ||
43 | @# To achieve this, we create a fake opam package that has our build-dependencies as | ||
44 | @# dependencies, but does not actually install anything itself. | ||
45 | @echo "# Installing builddep packages." | ||
46 | @opam install $(OPAMFLAGS) $(BUILDDEPFILES) | ||
47 | .PHONY: builddep | ||
48 | |||
49 | # Backwards compatibility target | ||
50 | build-dep: builddep | ||
51 | .PHONY: build-dep | ||
52 | |||
53 | # Some files that do *not* need to be forwarded to Makefile.coq. | ||
54 | # ("::" lets Makefile.local overwrite this.) | ||
55 | Makefile Makefile.local _CoqProject $(OPAMFILES):: ; | ||
diff --git a/README.md b/README.md new file mode 100644 index 0000000..ad7b1b7 --- /dev/null +++ b/README.md | |||
@@ -0,0 +1,383 @@ | |||
1 | Artifact for "Verified Interpreters for Dynamic Languages with Applications to the Nix Expression Language" | ||
2 | =========================================================================================================== | ||
3 | |||
4 | This is the accompanying artifact for the following paper: | ||
5 | > Rutger Broekhoff and Robbert Krebbers. 2025. Verified Interpreters for Dynamic Languages with Applications to the Nix Expression Language. _Proc. ACM Program. Lang._ 9, ICFP, Article 268 (August 2025), 29 pages. https://doi.org/10.1145/3747537 | ||
6 | |||
7 | This artifact primarily consists of two components: | ||
8 | 1. A Rocq formalization of the languages presented in the paper (LambdaLang; § 2, DynLang; § 3, EvalLang; § 3.4, NixLang; § 4). | ||
9 | This includes operational semantics and properties, an interpreter and correctness proof, plus some tests and examples. | ||
10 | 2. An OCaml front-end for NixLang (§ 5), which elaborates Nix source files into NixLang. | ||
11 | These are then evaluated using the NixLang interpreter, which is derived from the Rocq sources using Rocq's program extraction functionality. | ||
12 | |||
13 | > N.B.: If you are using the VM image that we provide for evaluating the artifact, then all necessary dependencies will already be installed using `opam`. | ||
14 | > You can directly proceed with using the [Dune project and Makefile](#dune-project-and-makefile) or [using the CLI](#usage-of-the-cli). | ||
15 | |||
16 | For the purposes of evaluating the artifact, we suggest the following steps: | ||
17 | 1. [Building](#building) (this must certainly be done first). | ||
18 | 2. Comparing that the mechanized semantics and interpreters of the defined languages match those presented in the paper. | ||
19 | The mechanization of all languages follows a [common structure](#structure-of-the-mechanization), but we also have a [table](#index-of-definitions-and-theories) that points you directly to the relevant definitions. | ||
20 | 3. Comparing that the mechanized theorems correspond to those presented in the paper. | ||
21 | We have a [table](#index-of-definitions-and-theories) that lists all theorems in the paper and their corresponding version in the formalization. | ||
22 | The paper mentions some properties/proofs in passing, we list the corresponding mechanized versions for these as well (but it may be less relevant to verify these, as they are primarily used as stepping stones for the major theorems presented in the paper). | ||
23 | 4. Exercising the Nix test suite on our interpreter and verifying that this gives the same results as presented in the paper (§ 5). | ||
24 | 5. Trying out some Nix programs in our REPL. | ||
25 | The paper (§ 1, § 4.1, § 5) contains some examples that might be interesting to try out. | ||
26 | |||
27 | You may also be interested in the [axioms used](#use-of-axioms) by the mechanization, or in reproducing the interpreter coverage number (91.77%, § 5, p. 22) and Table 1 (§ 5 p. 22). | ||
28 | How to do this depends on the build method that you are using, see the followings section. | ||
29 | |||
30 | > N.B.: We have only verified this artifact to function on Linux (Arch Linux, Debian) and macOS. It does not work on Windows. | ||
31 | |||
32 | ## Building | ||
33 | |||
34 | As mentioned at the start, this project consists of two parts: the Rocq mechanization and the front-end of the Nix interpreter. | ||
35 | The front-end of the Nix interpreter, which uses the makes use of the NixLang interpreter (written in Rocq, extracted to OCaml), is built using [Dune](https://dune.build/). | ||
36 | The Dune project also takes care of checking all of the parts of the Rocq mechanization, and extracting the NixLang interpreter to OCaml. | ||
37 | However, for convenience, we have a separate (classic) `Makefile` which checks only the Rocq sources (this may be more familiar to some, and will explicitly print the files being checked). | ||
38 | (Do note that Dune will refuse to build if the `.vo` files resulting from the checking process are not cleaned up; this can be done using `make clean`.) | ||
39 | |||
40 | *Both parts require dependencies.* | ||
41 | We have two main ways of managing the dependencies of the project: either using Nix or `opam`. | ||
42 | |||
43 | If you are familiar with Nix and have it available to you, it will likely be most easy to use. | ||
44 | If you are just interested in using Nix to build the project (so not directly interacting with the Dune project / Makefile), look [here](#building-with-nix). | ||
45 | If you are instead interested in interacting with `dune`, Makefile and/or other scripts in this repository, you should probably use the Nix devshell instead. | ||
46 | For that, look [here](#managing-dependencies-nix-devshell). | ||
47 | With the devshell set up, you can then proceed with using the [Dune project and Makefile](#dune-project-and-makefile). | ||
48 | |||
49 | If you cannot or do not want to use Nix, there is always still `opam`. | ||
50 | Look [here](#managing-dependencies-opam) to see how to install project dependencies with `opam`. | ||
51 | With the dependencies installed using `opam`, you can then proceed with using the [Dune project and Makefile](#dune-project-and-makefile). | ||
52 | |||
53 | ### Building with Nix | ||
54 | |||
55 | > N.B.: Only do this if you are solely interested in building/testing and/or using the artifact. If you are interested in being able to manually use the `Makefile` and Dune project, you should use a Nix devshell instead; look [here](#nix-devshell) for instructions. | ||
56 | |||
57 | Run `nix-build` (or equivalently `nix-build ./default.nix`) to build and test the artifact. This will take a few minutes. | ||
58 | The resulting CLI should then be available as `./result/bin/mininix`. | ||
59 | See how to use the CLI [below](#usage-of-the-cli). | ||
60 | For some more details on the test suite, look [here](#use-of-the-nix-language-tests). | ||
61 | |||
62 | Run `nix-build ./axioms.nix` to generate the list of axioms used by the formalization. | ||
63 | This is equivalent to running `make validate`. | ||
64 | The output of `coqchk` should be printed directly, but will also be stored at `./result/coqchk-output`. | ||
65 | See [below](#use-of-axioms) for more information on the axioms used. | ||
66 | |||
67 | In the paper, we report a 91.77% coverage for the interpreter code extracted from Rocq. | ||
68 | To generate the coverage report, run `nix-build ./coverage.nix`. | ||
69 | The coverage report should then be available as `./result/coverage/report-plain` (a text file, look for `lib/extraction/interp.ml` for the interpreter coverage). | ||
70 | A HTML version is also generated, the report for the interpreter should then be available under `./result/coverage/html/lib/extraction/interp.ml.html`. | ||
71 | |||
72 | To generate the line counts for the Rocq development (for comparison with Table 1 in the article), run `nix-build ./cloc.nix`. | ||
73 | The resulting report should be available as a text file `./result/formalization-loc-report`. | ||
74 | |||
75 | ### Managing dependencies: Nix devshell | ||
76 | |||
77 | The Nix devshell gives you a shell where all required dependencies are installed for you, so you do not have to fiddle with `opam`, but can still use the Dune project and Makefile that we provide. | ||
78 | There are a few ways that you can use the devshell. | ||
79 | |||
80 | Enter the devshell by running `nix-shell`. | ||
81 | You can then proceed with using the [Dune project and Makefile](#dune-project-and-makefile) *inside of the Nix devshell*. | ||
82 | |||
83 | ### Managing dependencies: opam | ||
84 | |||
85 | First, ensure that your `opam` repositories are up-to-date: | ||
86 | ```sh | ||
87 | opam update | ||
88 | ``` | ||
89 | |||
90 | For maximum flexibility and reproducibility, we recommend running the following | ||
91 | command to create a new opam switch in which the pinned dependencies are | ||
92 | installed (this includes the required Rocq, Flocq, Rocq-std++ versions etc.): | ||
93 | |||
94 | ```sh | ||
95 | # Leave out the --locked flag if not on Linux! | ||
96 | opam switch create ./ --repos default,rocq-released=https://rocq-prover.org/opam/released --deps-only --locked | ||
97 | ``` | ||
98 | |||
99 | It may be necessary to activate the newly set up opam switch as follows (if | ||
100 | you are not sure and opam instructs you to run this after creating the switch: | ||
101 | _do_ run it): | ||
102 | |||
103 | ```sh | ||
104 | eval $(opam env) | ||
105 | ``` | ||
106 | |||
107 | The [Dune project `Makefile`](#dune-project-and-makefile) can then be used as usual. | ||
108 | |||
109 | ### Dune project and `Makefile` | ||
110 | |||
111 | #### The Makefile (just the formalization) | ||
112 | |||
113 | If you are solely interested in the Rocq sources, you may make use of the `Makefile` to check and build Rocq sources and dependencies, provided that you have the appropriate [Rocq](https://rocq-prover.org/), [Flocq](https://flocq.gitlabpages.inria.fr/) and [Rocq-std++](https://gitlab.mpi-sws.org/iris/stdpp) versions available (8.20.1, 4.2.0/4.2.1 and 1.11.0 resp.). | ||
114 | When using a Nix devshell or an `opam` switch with the required dependencies installed (instructions above), this should work automatically. | ||
115 | |||
116 | Run `make` to check all files in the formalization. | ||
117 | Run `make validate` to print the axioms used. | ||
118 | See [below](#use-of-axioms) for more information on the axioms used. | ||
119 | |||
120 | #### The Dune project (formalization + front-end) | ||
121 | |||
122 | > N.B.: Dune will produce errors if `.vo` files generated by the `Makefile` are present. | ||
123 | > Remove these by running `make clean`. | ||
124 | > The Dune project will then build. | ||
125 | |||
126 | This step assumes that you have dependencies installed and available, either using `opam` or a Nix devshell. | ||
127 | See the relevant sections above. | ||
128 | |||
129 | To check all proofs and build the CLI, use `dune build -p mininix`. | ||
130 | To then run the CLI, use `./_build/default/bin/main.exe` (see how to use it [below](#usage-of-the-cli)). | ||
131 | To execute the test suite, use `dune test` (this may take a few minutes). | ||
132 | For some more details on the test suite, look [here](#use-of-the-nix-language-tests). | ||
133 | |||
134 | To generate the coverage report, run `./coverage.sh` (this will take a few minutes). | ||
135 | The report will then be printed directly (look for `lib/extraction/interp.ml`). | ||
136 | A detailed HTML report should also be available under `_coverage/html/lib/extraction/interp.ml.html`. | ||
137 | |||
138 | To generate the line counts for the Rocq development (for comparison with Table 1 in the article), make sure that `cloc` and `jq` are installed (if not using the provided Nix shell). | ||
139 | Then run `./cloc-rocq.sh` to print the report. | ||
140 | |||
141 | ## Usage of the CLI | ||
142 | |||
143 | Depending on how you built the CLI, it will be available to you as `./_build/default/bin/main.exe` (Dune) or `./result/bin/mininix` (Nix). | ||
144 | In these examples, replace `<cli>` with the actual path of the CLI binary. | ||
145 | |||
146 | - As a Nix REPL: `<cli> repl`. | ||
147 | Various meta-commands are available: `:quit`, `:run`, `:set` and `:settings`. | ||
148 | Autocomplete for these meta-commands is available; it is possible to cycle through suggestions using <kbd>TAB</kbd>. | ||
149 | Input can be canceled using <kbd>Ctrl+C</kbd> and the REPL can be quit using `:quit` or <kbd>Ctrl+D</kbd>. | ||
150 | The REPL evaluates in deep mode by default. | ||
151 | This can be changed by using `:set eval_strategy shallow`. | ||
152 | The REPL does not handle newlines in user input (a newline is processed as a request to process input). | ||
153 | |||
154 | The expected format of user input is the Nix language (although, as mentioned in the paper, e.g. derivations are not supported). | ||
155 | The paper (§ 1, § 4.1, § 5) contains some examples that might be interesting to try out. | ||
156 | - For evaluating single files: `<cli> eval FILENAME`. | ||
157 | This command evaluates in shallow mode by default. | ||
158 | You can change to deep mode by using the flag `-strict`. | ||
159 | An import tree definition file can be passed using the `-importsdef` flag. | ||
160 | See [below](#import-tree-definitions). | ||
161 | |||
162 | ## The Rocq mechanization | ||
163 | |||
164 | See how to check/build the mechanization [here](#build). | ||
165 | This section describes the different parts of the mechanization, and how it relates to the different parts of the article. | ||
166 | |||
167 | ### Use of axioms | ||
168 | |||
169 | See how to list the axioms used [above](#build) (look for the dependency management / build method that you are using). | ||
170 | (In case that you are using the Makefile (so dependencies are managed using `opam` / the Nix devshell): run `make validate`. If you are using Nix but not the devshell: use `nix-build ./axioms.nix` (the axioms used will also be written to `result/coqchk-output`).) | ||
171 | |||
172 | Use of four axioms will be reported, namely: | ||
173 | ``` | ||
174 | Coq.Logic.FunctionalExtensionality.functional_extensionality_dep | ||
175 | Coq.Reals.ClassicalDedekindReals.sig_not_dec | ||
176 | Coq.Reals.ClassicalDedekindReals.sig_forall_dec | ||
177 | Coq.Logic.Classical_Prop.classic | ||
178 | ``` | ||
179 | *These are not axioms that we directly make use of.* | ||
180 | Instead, they are marked as used because we import [Flocq](https://flocq.gitlabpages.inria.fr/) (so NixLang can support IEEE 754 floating point numbers, see `theories/nix/floats.v`), which imports the classical `Reals` module from the standard library. | ||
181 | Running `coqchk` on the `Reals` module from the standard library gives the same list of axioms as shown above. | ||
182 | |||
183 | ### Structure of the mechanization | ||
184 | |||
185 | There are two files that are shared by all four languages: | ||
186 | - `theories/res.v`: contains the `res` monad. See also Fig 2. on p. 6. | ||
187 | - `theories/utils.v`: contains some generic lemmas that are useful for all languages. | ||
188 | A decent amount of these are about finite maps, which we use heavily. | ||
189 | |||
190 | There is a general structure for all four languages that we formalize: | ||
191 | - `operational.v`: the definition of the operational semantics. | ||
192 | + Contains an inductive type `expr` for expressions. | ||
193 | + Contains a `step` relation that describes the small-step op. sem. | ||
194 | + Contains a `subst` function that gives parallel substitution (as used by `step`). | ||
195 | - `operational_props.v`: properties of the operational semantics. | ||
196 | + Contains a lemma `step_det`, proving that the small-step op. sem. is deterministic. | ||
197 | - `interp.v`: the definition of the interpreter. | ||
198 | + Contains the definition of values `val`, thunks `thunk` and environments `env`. | ||
199 | + Contains an `interp` function that takes some expression, environment and amount of fuel, and returns a result (timeout, fail or some value). | ||
200 | (In NixLang, we end up not using `interp` directly, but instead use `interp'` which wraps `interp` and allows specifying whether to evaluate in shallow/deep mode, cf. `⟦e⟧^{δ,E}_μ` (§ 4.4, p. 19).) | ||
201 | - `interp_proofs.v`: soundness and completeness of interpreter w.r.t. operational semantics, in three main theorems: | ||
202 | + `interp_sound_complete_ret_string` (or `interp_sound_complete_ret_lit` for NixLang) proving the soundness and completeness for programs that reduce to strings (or literals in general in NixLang). | ||
203 | + `interp_sound_complete_fail` proving the soundness and completeness for programs that fault. | ||
204 | + `interp_sound_complete_no_fuel` proving the soundness and completeness for programs that loop. | ||
205 | For LambdaLang, an extra condition here is that the programs that we are considering must be closed. | ||
206 | |||
207 | There is also always a generalized version of `interp_sound_complete_ret_string/lit`, namely `interp_sound_complete_ret`, which states that the interpreter is sound and complete w.r.t. the operational semantics for (in case of LambdaLang closed) programs that reduce to a value. | ||
208 | |||
209 | Specific to the different languages are the following files: | ||
210 | - In `theories/dynlang` (for DynLang, § 3): | ||
211 | + `equiv.v`, the equivalence of LambdaLang and DynLang for closed LambdaLang terms. | ||
212 | - In `theories/evallang` (for EvalLang, § 3.4): | ||
213 | + `tests.v`, some tests of the EvalLang expression parser and interpreter. | ||
214 | - In `theories/nix` (for NixLang, § 4): | ||
215 | + `floats.v`: our Flocq instantiation with some helper functions. | ||
216 | + `notations.v`: some notations to make writing NixLang programs in Rocq easier. | ||
217 | + `tests.v`: some example NixLang programs to test the functionality of the interpreter with. | ||
218 | + `wp.v`: the definition of our proof-of-concept weakest precondition-based program logic, derived rules (see § 5). | ||
219 | + `wp_examples.v`: examples of use of our WP-based program logic (see § 5). | ||
220 | |||
221 | ### Index of definitions and theories | ||
222 | |||
223 | **Relevant definitions.** | ||
224 | |||
225 | | In paper | File and line number | Name | | ||
226 | |----------------------------------------------------|---------------------------------------|--------------------------------| | ||
227 | | Shared result monad (p. 6) | `theories/res.v:4` | `res` | | ||
228 | | LambdaLang syntax (p. 6) | `theories/lambda/operational.v:6` | `expr` | | ||
229 | | LambdaLang operational semantics (p. 6) | `theories/lambda/operational.v:21` | `step` | | ||
230 | | LambdaLang final expressions (p. 6) | `theories/lambda/operational.v:28` | `final` | | ||
231 | | LambdaLang parallel substitution (p. 6) | `theories/lambda/operational.v:12` | `subst` | | ||
232 | | LambdaLang interpreter (p. 6) | `theories/lambda/interp.v:34` | `interp` | | ||
233 | | LambdaLang interpreter data structures (p. 6) | `theories/lambda/interp.v:7-14` | `thunk`, `env`, `val` | | ||
234 | | DynLang syntax (p. 9) | `theories/dynlang/operational.v:6` | `expr` | | ||
235 | | DynLang operational semantics (p. 9) | `theories/dynlang/operational.v:21` | `step` | | ||
236 | | DynLang final expressions (p. 9) | `theories/dynlang/operational.v:31` | `final` | | ||
237 | | DynLang parallel substitution (p. 9) | `theories/dynlang/operational.v:12` | `subst` | | ||
238 | | DynLang interpreter (p. 9) | `theories/dynlang/interp.v:39` | `interp` | | ||
239 | | DynLang interpreter data structures (p. 9) | `theories/dynlang/interp.v:7-13` | `thunk`, `env`, `val` | | ||
240 | | EvalLang syntax (p. 11) | `theories/evallang/operational.v:7` | `expr` | | ||
241 | | EvalLang expression parser (p. 11) | `theories/evallang/operational.v:103` | `parse` | | ||
242 | | EvalLang operational semantics (p. 11) | `theories/evallang/operational.v:119` | `step` | | ||
243 | | EvalLang final expressions (p. 11) | `theories/evallang/operational.v:130` | `final` | | ||
244 | | EvalLang interpreter (p. 11) | `theories/evallang/interp.v:42` | `interp` | | ||
245 | | EvalLang interpreter data structures (p. 11) | `theories/evallang/interp.v:7-13` | `thunk`, `env`, `val` | | ||
246 | | NixLang syntax (p. 14) | `theories/nix/operational.v:67` | `expr` | | ||
247 | | NixLang operational semantics (p. 14) | `theories/nix/operational.v:444` | `step` | | ||
248 | | NixLang evaluation contexts (p. 14) | `theories/nix/operational.v:418` | `ctx1` | | ||
249 | | NixLang final expressions (p. 14) | `theories/nix/operational.v:139` | `final` | | ||
250 | | NixLang binary operator semantics (p. 15) | `theories/nix/operational.v:297` | `sem_bin_op` | | ||
251 | | NixLang argument matching (p. 15) | `theories/nix/operational.v:398` | `matches` | | ||
252 | | NixLang substitution (p. 15) | `theories/nix/operational.v:112` | `subst` | | ||
253 | | NixLang interpreter (p. 18) | `theories/nix/interp.v:329` | `interp` | | ||
254 | | NixLang interpreter data structures (p. 18) | `theories/nix/interp.v:5-21` | `val`, `thunk`, `tattr`, `env` | | ||
255 | | NixLang interpreter variant with mode arg. (p. 19) | `theories/nix/interp.v:348` | `interp'` | | ||
256 | |||
257 | **Corresponding theorems.** | ||
258 | |||
259 | | Theorem in paper | File and line number | Name | | ||
260 | |---------------------------------|---------------------------------------|------------------------------------| | ||
261 | | Theorem 2.1, Item 1 (p. 7) | `theories/lambda/interp_proofs.v:575` | `interp_sound_complete_ret_string` | | ||
262 | | Theorem 2.1, Item 2 (p. 7) | `theories/lambda/interp_proofs.v:585` | `interp_sound_complete_fail` | | ||
263 | | Theorem 2.1, Item 3 (p. 7) | `theories/lambda/interp_proofs.v:594` | `interp_sound_complete_no_fuel` | | ||
264 | | Lemma 2.2 (p. 8) | `theories/lambda/interp_proofs.v:516` | `interp_sound_open` | | ||
265 | | Lemma 2.3 (p. 8) | `theories/lambda/interp_proofs.v:402` | `interp_step` | | ||
266 | | Lemma 2.4 (p. 8) | `theories/lambda/interp_proofs.v:297` | `interp_proper` | | ||
267 | | Theorem 3.1, Item 1 (p. 11) | `theories/dynlang/equiv.v:120` | `interp_equiv_ret_string` | | ||
268 | | Theorem 3.1, Item 2 (p. 11) | `theories/dynlang/equiv.v:131` | `interp_equiv_fail` | | ||
269 | | Theorem 3.1, Item 3 (p. 11) | `theories/dynlang/equiv.v:142` | `interp_equiv_no_fuel` | | ||
270 | | Theorem 4.1, Item 1 (p. 20) (*) | `theories/nix/interp_proofs.v:2655` | `interp_sound_complete_ret_lit` | | ||
271 | | Theorem 4.1, Item 2 (p. 20) | `theories/nix/interp_proofs.v:2665` | `interp_sound_complete_fail` | | ||
272 | | Theorem 4.1, Item 3 (p. 20) | `theories/nix/interp_proofs.v:2673` | `interp_sound_complete_no_fuel` | | ||
273 | | Lemma 4.2 (p. 20) | `theories/nix/interp_proofs.v:2619` | `interp_sound_open'` | | ||
274 | | Lemma 4.3 (p. 20) | `theories/nix/interp_proofs.v:2029` | `interp_step'` | | ||
275 | |||
276 | (*): The theorem in the formalization is stronger than the theorem presented in the paper. The latter is a trivial specialization of the former. | ||
277 | |||
278 | **Other claims in the paper.** | ||
279 | |||
280 | - § 2, LambdaLang: | ||
281 | + p. 7: Theorem 2.1, Item 1 generalizes to any final value. | ||
282 | See `theories/lambda/interp_proofs.v:563`, `interp_sound_complete_ret`. | ||
283 | This also holds for DynLang, EvalLang and NixLang. | ||
284 | These languages have a theory `interp_sound_complete_ret` in their respective `interp_proofs.v` files as well. | ||
285 | + p. 7: LambdaLang has a deterministic operational semantics. See `theories/lambda/operational_props.v:19`, `step_det`. | ||
286 | This also holds for DynLang, EvalLang and NixLang. | ||
287 | These languages have a theory `step_det` in their respective `operational_props.v` files as well. | ||
288 | - § 3, DynLang: | ||
289 | + p. 10: A variant of the main theorem of DynLang (Theorem 2.1) also holds for DynLang. | ||
290 | The primary difference here is that the closedness conditions are not needed for DynLang. | ||
291 | For a variant of Theorem 2.1, Item 1, see `theories/dynlang/interp_proofs.v:391`, `interp_sound_complete_ret_string`. | ||
292 | For a variant of Theorem 2.1, Item 2, see `theories/dynlang/interp_proofs.v:400`, `interp_sound_complete_fail`. | ||
293 | For a variant of Theorem 2.1, Item 3, see `theories/dynlang/interp_proofs.v:408`, `interp_sound_complete_no_fuel`. | ||
294 | A variant of the generalized version of Theorem 2.1, Item 1 also holds for DynLang. | ||
295 | See `theories/dynlang/interp_proofs.v:381`, `interp_sound_complete_ret`. | ||
296 | - § 4, NixLang: | ||
297 | + p. 19/20: Theorem 4.1, Item 1 generalizes to any final value. | ||
298 | + p. 20: Lemma 4.2 follows from mutual induction on four properties. | ||
299 | For these four properties and their corresponding proof, see `theories/nix/interp_proofs.v:2267-2282` (`interp_sound_open`, `interp_thunk_sound`, `interp_app_sound`, `force_deep_sound`). | ||
300 | + p. 20: Lemma 4.3 follows from mutual induction on two properties. | ||
301 | For these two properties and their corresponding proof, see `theories/nix/interp_proofs.v:1519`, `interp_step`. | ||
302 | - § 5, Evaluation (Program logic, p. 22): | ||
303 | + We can derive structural rules for WP (the application rule is presented). | ||
304 | See `theories/nix/wp.v:55`, `App_wp` for the presented application rule. | ||
305 | In general, `theories/nix/wp.v` contains all derived rules for WP. | ||
306 | + We prove the total correctness of three variants of the recursive program from § 4.1: | ||
307 | * See `theories/nix/wp_examples.v:84`, `even_rec_attr_wp'` for | ||
308 | ```nix | ||
309 | rec { f = x: if x = 0 then true else !(f (x - 1)); }.f n | ||
310 | ``` | ||
311 | * See `theories/nix/wp_examples.v:132`, `even_rec_functor_wp'` for | ||
312 | ```nix | ||
313 | { "__functor " = r: x: if x == 0 then true else !(r (x - 1)); } n | ||
314 | ``` | ||
315 | * See `theories/nix/wp_examples.v:157`, `even_rec_default_wp'` for | ||
316 | ```nix | ||
317 | ({ f ? (x: if x == 0 then true else !(f (x - 1))) }: f) {} n | ||
318 | ``` | ||
319 | + We prove the total correctness of the following program for any non-recursive attribute set `e`: | ||
320 | ```nix | ||
321 | let x = 1; in with e; with { y = 2; }; x == y | ||
322 | ``` | ||
323 | See `theories/nix/wp_examples.v:11`, `test_wp`. | ||
324 | |||
325 | ## Import tree definitions | ||
326 | |||
327 | We do not claim to have (proper) support the `import` feature of Nix, but we do support it in a bare-bones fashion in order to be able to run the test suite. | ||
328 | In the test suite, there is a file `lib.nix`, which a few test cases load by using `with import ./lib.nix; ...` (or something similar). | ||
329 | To support this, we use a so-called import tree definition file, which pre-declares all files that may be imported. | ||
330 | In the test suite, for example, we have created a `test/testdata/importdef.sexp` file, which looks like this: | ||
331 | ``` | ||
332 | (deps ./lib.nix) | ||
333 | ``` | ||
334 | This means that the file `lib.nix` should be available to be imported for all files in the `test/testdata` folder. | ||
335 | Such `importdef.sexp` files are discovered automatically by walking up the directory tree from the path of the file to be evaluated (or in case of the REPL, from the current working directory). | ||
336 | The general syntax (`<forest>`) is as follows: `(deps <tree>)`, where `<tree>` is either `<filename>` or `(<filename> <forest>)` | ||
337 | |||
338 | In general, the primitive imports mechanism works as follows: | ||
339 | |||
340 | - All path expressions (_e.g.,_ `./lib.nix`) in the Nix source file are converted to strings representing their absolute path. | ||
341 | - We load all dependencies and evaluate them to NixLang values. | ||
342 | - We put all of these values in a NixLang attribute set (`VAttr`, see `theories/nix/interp.v:14`), where we associate the NixLang value of each imported file with the original filename (as an absolute path). | ||
343 | - We then create a NixLang function `import <filename>` (using `VClo`, see `theories/nix/interp.v:9`) that takes a string and returns the value for that file (if indeed forward-declared in the import tree definition). | ||
344 | - This function is then inserted into the global environment of the file that we want to evaluate. | ||
345 | |||
346 | This process is performed recursively, hence recursive imports are also supported. | ||
347 | |||
348 | ## Use of the Nix language tests | ||
349 | |||
350 | When exercising the official Nix language tests on our extracted interpreter, we do not exactly consider all tests in the Nix test suite. | ||
351 | Since we are only interested in tests for the interpreter, and not so much in tests for the parser, we only consider the `eval-*` test files in the `test/testdata` folder. | ||
352 | There are two types of tests that we have here: tests where evaluation should succeed, and tests where evaluation should fail. | ||
353 | This is simply marked in the filename; Nix files that should fail to evaluate are named `eval-fail-*.nix` and files that should evaluate successfully are named `eval-okay-*.nix`. | ||
354 | For the former, there are expected error outputs that the interpreter should produce, but we are not interested in reproducing these (nor would this be realistic with our setup). | ||
355 | |||
356 | For the latter, there are also expected output expressions, which can be found in matching `eval-okay-*.exp`. | ||
357 | However, there are two `eval-okay-*.nix` files for which no such matching `eval-okay-*.exp` file exists: | ||
358 | - `eval-okay-tail-call-1.nix`: a file `eval-okay-tail-call-1.exp-disabled` exists; we hence do not consider this test. | ||
359 | - `eval-okay-xml.nix`: a file `eval-okay-xml.exp.xml` exists, but we are not interested in converting the resulting term to XML to validate the result of this test. | ||
360 | |||
361 | The total amount of `eval-fail-*.nix` files and pairs of `eval-okay-*.nix` and `eval-okay-*.exp` files informs our total count of interpreter tests that we consider to begin with, namely 182 (§ 5, p. 21). | ||
362 | For these tests again, we explicitly list 74 tests that should be ignored in `./test/test_mininix.ml`, since they cover functionality of Nix that is out of scope for our paper. | ||
363 | We end up with 108 tests that we exercise our interpreter on. | ||
364 | Our interpreter passes 103 of these tests, and times out for five tests due to its call-by-name nature. | ||
365 | Some more details can be found in the paper, in § 5. | ||
366 | |||
367 | ## General project structure | ||
368 | |||
369 | - The `theories` folder contains the Rocq formalization. See the [structure of the mechanization](#structure-of-the-mechanization). | ||
370 | - The `bin` folder contains the entrypoint for the command-line interface. | ||
371 | - The `lib` folder contains the Nix parser, elaborator and interpreter extraction | ||
372 | + The `nix` subfolder contains an adapted version of the parser and pretty-printer from nixformat (licensed under ISC) by Denis Korzunov. | ||
373 | See https://github.com/d2km/nixformat. | ||
374 | Some improvements were made to the parser and pretty-printer. | ||
375 | The file `elaborator.ml`, not part of nixformat, in this folder is concerned with desugaring attribute paths among other things; you may consider this a 'normalizing' stage, which allows the elaborator to our core language to be more concise. | ||
376 | + The `mininix` subfolder is the most important here. It contains, among | ||
377 | other files: | ||
378 | - `nix2mininix.ml`, elaboration of Nix into our core language | ||
379 | - `builtins.nix`, our implementation of builtins in Nix, in our core Nix language, where we liberally use 'core' builtins (available as binary operations) that are specific to the core language | ||
380 | - `conv.ml`, conversion between numeric types in OCaml and Rocq/Flocq | ||
381 | - `import.ml`, very bare-bones support for imports, used in the test suite | ||
382 | + The `extraction` folder contains a file that extracts the core language interpreter and some auxiliary functions to OCaml | ||
383 | - The `explorer` folder contains some utilities for converting the Rocq Mechanization to a static site. | ||
diff --git a/_CoqProject b/_CoqProject new file mode 100644 index 0000000..49e7e24 --- /dev/null +++ b/_CoqProject | |||
@@ -0,0 +1,31 @@ | |||
1 | -Q theories mininix | ||
2 | |||
3 | theories/utils.v | ||
4 | theories/res.v | ||
5 | |||
6 | theories/lambda/operational.v | ||
7 | theories/lambda/operational_props.v | ||
8 | theories/lambda/interp.v | ||
9 | theories/lambda/interp_proofs.v | ||
10 | |||
11 | theories/dynlang/operational.v | ||
12 | theories/dynlang/operational_props.v | ||
13 | theories/dynlang/interp.v | ||
14 | theories/dynlang/interp_proofs.v | ||
15 | theories/dynlang/equiv.v | ||
16 | |||
17 | theories/evallang/operational.v | ||
18 | theories/evallang/operational_props.v | ||
19 | theories/evallang/interp.v | ||
20 | theories/evallang/interp_proofs.v | ||
21 | theories/evallang/tests.v | ||
22 | |||
23 | theories/nix/floats.v | ||
24 | theories/nix/operational.v | ||
25 | theories/nix/operational_props.v | ||
26 | theories/nix/interp.v | ||
27 | theories/nix/notations.v | ||
28 | theories/nix/tests.v | ||
29 | theories/nix/interp_proofs.v | ||
30 | theories/nix/wp.v | ||
31 | theories/nix/wp_examples.v | ||
diff --git a/axioms.nix b/axioms.nix new file mode 100644 index 0000000..1bdbefb --- /dev/null +++ b/axioms.nix | |||
@@ -0,0 +1,22 @@ | |||
1 | { pkgs ? import ./nixpkgs-pinned.nix {} }: with pkgs; | ||
2 | |||
3 | stdenv.mkDerivation { | ||
4 | name = "mininix-axioms"; | ||
5 | |||
6 | src = ./.; | ||
7 | |||
8 | nativeBuildInputs = [ coq_8_20 ]; | ||
9 | buildInputs = (with coqPackages_8_20; [ | ||
10 | flocq | ||
11 | stdpp | ||
12 | ]); | ||
13 | |||
14 | buildPhase = '' | ||
15 | make validate 2>&1 | tee coqchk-output | ||
16 | ''; | ||
17 | |||
18 | installPhase = '' | ||
19 | mkdir -p $out | ||
20 | mv coqchk-output $out | ||
21 | ''; | ||
22 | } | ||
diff --git a/bin/dune b/bin/dune new file mode 100644 index 0000000..2a56b29 --- /dev/null +++ b/bin/dune | |||
@@ -0,0 +1,14 @@ | |||
1 | (executable | ||
2 | (public_name mininix) | ||
3 | (name main) | ||
4 | (preprocess | ||
5 | (pps ppx_let)) | ||
6 | (libraries | ||
7 | nix | ||
8 | core | ||
9 | core_unix.command_unix | ||
10 | linenoise | ||
11 | mininix | ||
12 | sexp_pretty | ||
13 | stdio | ||
14 | ppx_let)) | ||
diff --git a/bin/main.ml b/bin/main.ml new file mode 100644 index 0000000..e4ca4b9 --- /dev/null +++ b/bin/main.ml | |||
@@ -0,0 +1,26 @@ | |||
1 | open Core | ||
2 | |||
3 | let repl = | ||
4 | Command.basic ~summary:"run the Mininix REPL" (Command.Param.return Repl.run) | ||
5 | |||
6 | let eval = | ||
7 | Command.basic ~summary:"run a Nix file" | ||
8 | (let%map_open.Command filename = anon ("FILENAME" %: string) | ||
9 | and strict = flag "strict" no_arg ~doc:"use deep evaluation strategy" | ||
10 | and importsdef = | ||
11 | flag "importsdef" (optional string) ~doc:"import tree definition file" | ||
12 | in | ||
13 | fun () -> | ||
14 | Settings.opts.eval_strategy := if strict then `Deep else `Shallow; | ||
15 | Settings.opts.imports_def_file := importsdef; | ||
16 | let ok = | ||
17 | if String.(filename = "-") then Run.eval_stdin () | ||
18 | else Run.eval_file filename | ||
19 | in | ||
20 | if ok then exit 0 else exit 1) | ||
21 | |||
22 | let main = | ||
23 | Command.group ~summary:"the Mininix interpreter" | ||
24 | [ ("repl", repl); ("eval", eval) ] | ||
25 | |||
26 | let () = Command_unix.run main | ||
diff --git a/bin/repl.ml b/bin/repl.ml new file mode 100644 index 0000000..092c503 --- /dev/null +++ b/bin/repl.ml | |||
@@ -0,0 +1,52 @@ | |||
1 | open Core | ||
2 | open Option.Let_syntax | ||
3 | |||
4 | let ok = ref true | ||
5 | let opts = Settings.opts | ||
6 | |||
7 | let rec user_input cb = | ||
8 | let prompt = (if !ok then "[okay]" else "[fail]") ^ " (mini)nix> " in | ||
9 | try | ||
10 | match LNoise.linenoise prompt with | ||
11 | | None -> () | ||
12 | | Some v -> | ||
13 | cb v; | ||
14 | user_input cb | ||
15 | with Sys_unix.Break -> | ||
16 | printf "\n%!"; | ||
17 | user_input cb | ||
18 | |||
19 | let split_cmd_prefix cmd = | ||
20 | let%bind cmd = String.chop_prefix ~prefix:":" cmd in | ||
21 | let cmd' = Repl_cmd.lstrip_space cmd in | ||
22 | let space = String.chop_suffix_exn cmd ~suffix:cmd' in | ||
23 | return (":" ^ space, cmd') | ||
24 | |||
25 | let handle_cmd cmd = | ||
26 | let cmd = Repl_cmd.strip_space cmd in | ||
27 | (match split_cmd_prefix cmd with | ||
28 | | Some (_, cmd) -> ok := Repl_cmd.invoke cmd | ||
29 | | None -> | ||
30 | if String.(strip cmd <> "") then | ||
31 | ok := Run.eval_expr cmd ~origin:Interactive); | ||
32 | printf "\n%!" | ||
33 | |||
34 | let run () = | ||
35 | LNoise.set_multiline true; | ||
36 | LNoise.history_load ~filename:"mininix_history" |> ignore; | ||
37 | LNoise.history_set ~max_length:500 |> ignore; | ||
38 | LNoise.set_hints_callback (fun line -> | ||
39 | let%bind _, cmd = split_cmd_prefix line in | ||
40 | let%bind hint = Repl_cmd.hint cmd in | ||
41 | return (hint, LNoise.Yellow, true)); | ||
42 | LNoise.set_completion_callback (fun line_so_far completions -> | ||
43 | match split_cmd_prefix line_so_far with | ||
44 | | Some (prefix, cmd_so_far) -> | ||
45 | Repl_cmd.complete cmd_so_far | ||
46 | |> List.map ~f:(String.append prefix) | ||
47 | |> List.iter ~f:(LNoise.add_completion completions) | ||
48 | | None -> ()); | ||
49 | user_input (fun from_user -> | ||
50 | LNoise.history_add from_user |> ignore; | ||
51 | LNoise.history_save ~filename:"mininix_history" |> ignore; | ||
52 | handle_cmd from_user) | ||
diff --git a/bin/repl_cmd.ml b/bin/repl_cmd.ml new file mode 100644 index 0000000..9ebeae7 --- /dev/null +++ b/bin/repl_cmd.ml | |||
@@ -0,0 +1,178 @@ | |||
1 | open Core | ||
2 | open Option.Let_syntax | ||
3 | |||
4 | let join_str_list ~sep = function | ||
5 | | [] -> "" | ||
6 | | s :: ss -> List.fold ss ~init:s ~f:(fun acc s -> acc ^ sep ^ s) | ||
7 | |||
8 | type cmd = { | ||
9 | args : string; | ||
10 | opts : unit -> string list; | ||
11 | next : (string -> (string, cmd) Either.t) option; | ||
12 | call : string list -> bool; | ||
13 | } | ||
14 | |||
15 | let set_opt_cmd opt setting = | ||
16 | { | ||
17 | args = "<option value>"; | ||
18 | opts = (fun () -> Settings.allowed_values setting); | ||
19 | next = None; | ||
20 | call = | ||
21 | (fun args -> | ||
22 | match Settings.set_to setting args with | ||
23 | | None -> true | ||
24 | | Some msg -> | ||
25 | printf "Failed to set option %s: %s\n%!" opt msg; | ||
26 | false); | ||
27 | } | ||
28 | |||
29 | let set_cmd = | ||
30 | { | ||
31 | args = "<option name> <option value>"; | ||
32 | opts = (fun () -> Map.keys Settings.settings); | ||
33 | next = | ||
34 | Some | ||
35 | (fun opt -> | ||
36 | match Map.find Settings.settings opt with | ||
37 | | Some setting -> Second (set_opt_cmd opt setting) | ||
38 | | None -> First (sprintf "Unknown option '%s'" opt)); | ||
39 | call = | ||
40 | (fun _ -> | ||
41 | printf "Missing option argument value\n%!"; | ||
42 | false); | ||
43 | } | ||
44 | |||
45 | let settings_cmd = | ||
46 | { | ||
47 | args = ""; | ||
48 | opts = (fun () -> []); | ||
49 | next = None; | ||
50 | call = | ||
51 | (function | ||
52 | | [] -> | ||
53 | Settings.print (); | ||
54 | true | ||
55 | | _ -> | ||
56 | printf "Expected no arguments\n%!"; | ||
57 | false); | ||
58 | } | ||
59 | |||
60 | let run_cmd = | ||
61 | { | ||
62 | args = "<filename>"; | ||
63 | opts = (fun () -> []); | ||
64 | next = None; | ||
65 | call = | ||
66 | (function | ||
67 | | [ filename ] -> Run.eval_file filename | ||
68 | | _ -> | ||
69 | printf "Expected one argument (the filename)\n%!"; | ||
70 | false); | ||
71 | } | ||
72 | |||
73 | let quit_cmd = | ||
74 | { args = ""; opts = (fun () -> []); next = None; call = (fun _ -> exit 0) } | ||
75 | |||
76 | let commands = | ||
77 | Map.of_alist_exn | ||
78 | (module String) | ||
79 | [ | ||
80 | ("quit", quit_cmd); | ||
81 | ("set", set_cmd); | ||
82 | ("settings", settings_cmd); | ||
83 | ("run", run_cmd); | ||
84 | ] | ||
85 | |||
86 | let root_cmd = | ||
87 | { | ||
88 | args = "<command>"; | ||
89 | opts = (fun () -> Map.keys commands); | ||
90 | next = | ||
91 | Some | ||
92 | (fun cmd_name -> | ||
93 | match Map.find commands cmd_name with | ||
94 | | Some cmd -> Second cmd | ||
95 | | None -> | ||
96 | First | ||
97 | (sprintf "Unknown command '%s' (expected one of {%s})" cmd_name | ||
98 | (Map.keys commands |> join_str_list ~sep:", "))); | ||
99 | call = | ||
100 | (fun _ -> | ||
101 | printf "Missing command!\n%!"; | ||
102 | false); | ||
103 | } | ||
104 | |||
105 | let is_space = Char.( = ) ' ' | ||
106 | let strip_space = String.strip ~drop:is_space | ||
107 | let lstrip_space = String.lstrip ~drop:is_space | ||
108 | |||
109 | let clean_str_list ss = | ||
110 | ss |> List.map ~f:strip_space | ||
111 | |> List.filter ~f:(fun s -> not (String.is_empty s)) | ||
112 | |||
113 | let words s = s |> String.split ~on:' ' |> clean_str_list | ||
114 | let unwords ss = clean_str_list ss |> join_str_list ~sep:" " | ||
115 | |||
116 | let rec call cmd args = | ||
117 | match args with | ||
118 | | [] -> cmd.call [] | ||
119 | | arg0 :: argn -> ( | ||
120 | match cmd.next with | ||
121 | | None -> cmd.call args | ||
122 | | Some next -> ( | ||
123 | match next arg0 with | ||
124 | | First msg -> | ||
125 | printf "%s\n%!" msg; | ||
126 | false | ||
127 | | Second cmd' -> call cmd' argn)) | ||
128 | |||
129 | let try_lsplit2_space s = | ||
130 | match String.lsplit2 s ~on:' ' with Some (l, r) -> (l, r) | None -> (s, "") | ||
131 | |||
132 | let lsplit2_space' s = | ||
133 | let%bind l, r = String.lsplit2 s ~on:' ' in | ||
134 | (* s = l ^ " " ^ r *) | ||
135 | let r' = lstrip_space r in | ||
136 | let space = " " ^ String.chop_suffix_exn r ~suffix:r' in | ||
137 | (* s = l ^ space ^ r' *) | ||
138 | return (l, space, r') | ||
139 | |||
140 | let rec completions cmd args = | ||
141 | (* cmd|<TAB> -> options | ||
142 | cmd|abc<TAB> -> options with prefix 'abc' | ||
143 | cmd|abc .*<TAB> -> subcommand 'abc' options, pass .* *) | ||
144 | if String.(args = "") then cmd.opts () | ||
145 | else | ||
146 | match lsplit2_space' args with | ||
147 | | None -> cmd.opts () |> List.filter ~f:(String.is_prefix ~prefix:args) | ||
148 | | Some (arg0, space, argn) -> ( | ||
149 | match cmd.next with | ||
150 | | None -> [] | ||
151 | | Some next -> ( | ||
152 | match next arg0 with | ||
153 | | First _ -> [] | ||
154 | | Second cmd' -> | ||
155 | completions cmd' argn | ||
156 | |> List.map ~f:(String.append (arg0 ^ space)))) | ||
157 | |||
158 | let rec hints cmd args = | ||
159 | (* cmd: "" -> " <args>" | ||
160 | cmd: "<space>+" -> "<args>" | ||
161 | cmd: "<space>+<subcmd>" -> "<hints for subcmd>" | ||
162 | cmd: "<space>+<subcmd> .*" -> "<hints for subcmd with .*>" *) | ||
163 | if String.(args = "") then Some (" " ^ cmd.args) | ||
164 | else if String.(strip_space args = "") then Some cmd.args | ||
165 | else | ||
166 | let args = lstrip_space args in | ||
167 | let%bind next = cmd.next in | ||
168 | match lsplit2_space' args with | ||
169 | | None -> | ||
170 | let%bind cmd' = next args |> Either.Second.to_option in | ||
171 | hints cmd' "" | ||
172 | | Some (arg0, space, argn) -> | ||
173 | let%bind cmd' = next arg0 |> Either.Second.to_option in | ||
174 | hints cmd' (space ^ argn) | ||
175 | |||
176 | let invoke cmd = call root_cmd (words cmd) | ||
177 | let complete cmd = completions root_cmd cmd | ||
178 | let hint cmd = hints root_cmd cmd | ||
diff --git a/bin/run.ml b/bin/run.ml new file mode 100644 index 0000000..f39997c --- /dev/null +++ b/bin/run.ml | |||
@@ -0,0 +1,163 @@ | |||
1 | open Core | ||
2 | |||
3 | let opts = Settings.opts | ||
4 | |||
5 | module Origin = struct | ||
6 | type t = Filename of string | Stdin | Interactive | ||
7 | |||
8 | let to_string = function | ||
9 | | Filename name -> name | ||
10 | | Stdin -> "<stdin>" | ||
11 | | Interactive -> "<interactive>" | ||
12 | end | ||
13 | |||
14 | (* [dir] must be an absolute path *) | ||
15 | let rec find_imports_file dir : (string, string) result = | ||
16 | let def_filename = Filename.concat dir "importdef.sexp" in | ||
17 | match Core_unix.access def_filename [ `Read ] with | ||
18 | | Ok () -> Ok def_filename | ||
19 | | Error (Core_unix.Unix_error (ENOENT, _, _)) | ||
20 | | Error (Core_unix.Unix_error (EACCES, _, _)) -> | ||
21 | let parent = Filename.dirname dir in | ||
22 | if String.(parent = dir) then Error "Could not find importdef.sexp file" | ||
23 | else find_imports_file (Filename.dirname dir) | ||
24 | | Error _ -> Error "Could not find importdef.sexp file" | ||
25 | |||
26 | let load_imports ~for_ = | ||
27 | let cwd = Core_unix.getcwd () in | ||
28 | let filename = | ||
29 | match !(opts.imports_def_file) with | ||
30 | | None -> ( | ||
31 | let dir = | ||
32 | match for_ with | ||
33 | | Origin.Filename filename -> | ||
34 | Filename.to_absolute_exn | ||
35 | (Filename.dirname filename) | ||
36 | ~relative_to:cwd | ||
37 | | Origin.Stdin | Origin.Interactive -> cwd | ||
38 | in | ||
39 | match find_imports_file dir with | ||
40 | | Error _ -> | ||
41 | printf | ||
42 | "Note: no importdef.sexp was found / could be accessed; imports \ | ||
43 | will not work\n\ | ||
44 | %!"; | ||
45 | None | ||
46 | | Ok filename -> | ||
47 | let relative = | ||
48 | if Filename.is_absolute filename then | ||
49 | Filename.of_absolute_exn filename ~relative_to:cwd | ||
50 | else filename | ||
51 | in | ||
52 | printf "Imports definition found at %s\n%!" relative; | ||
53 | Some filename) | ||
54 | | Some filename -> Some filename | ||
55 | in | ||
56 | match filename with | ||
57 | | None -> Ok [] | ||
58 | | Some filename -> ( | ||
59 | (* User-provided filenames may not be absolute *) | ||
60 | let filename_abs = Filename.to_absolute_exn filename ~relative_to:cwd in | ||
61 | try | ||
62 | Ok | ||
63 | (In_channel.read_all filename | ||
64 | |> Sexp.of_string |> Mininix.Sexp.import_forest_of_sexp | ||
65 | |> Mininix.Import.materialize | ||
66 | ~relative_to:(Filename.dirname filename_abs)) | ||
67 | with Sys_error err -> Error ("Failed to read imports definition: " ^ err)) | ||
68 | |||
69 | let eval_expr_with_imports ~origin ~imports data = | ||
70 | let cwd = Core_unix.getcwd () in | ||
71 | let config = Sexp_pretty.Config.default | ||
72 | and formatter = Stdlib.Format.formatter_of_out_channel stdout in | ||
73 | try | ||
74 | if !(opts.print_input) then printf "==> Input Nix:\n%s\n\n%!" data; | ||
75 | let nexp = Nix.parse ~filename:(Origin.to_string origin) data in | ||
76 | if !(opts.print_parsed) then ( | ||
77 | print_string "==> Parsed Nix:\n"; | ||
78 | Nix.Printer.print stdout nexp; | ||
79 | printf "\n\n%!"); | ||
80 | let nnexp = | ||
81 | Nix.elaborate | ||
82 | ~dir: | ||
83 | (Some | ||
84 | (match origin with | ||
85 | | Filename name -> | ||
86 | Filename.to_absolute_exn ~relative_to:cwd | ||
87 | (Filename.dirname name) | ||
88 | | Stdin | Interactive -> cwd)) | ||
89 | nexp | ||
90 | in | ||
91 | if !(opts.print_elaborated) then ( | ||
92 | print_string "==> Parsed, elaborated Nix:\n"; | ||
93 | Nix.Printer.print stdout nnexp; | ||
94 | printf "\n\n%!"); | ||
95 | if !(opts.print_nix_sexp) then ( | ||
96 | let nsexp = Nix.Ast.sexp_of_expr nnexp in | ||
97 | print_string "==> Nix S-expr:\n"; | ||
98 | Sexp_pretty.pp_formatter config formatter nsexp; | ||
99 | printf "\n%!"); | ||
100 | let mnexp = Mininix.Nix2mininix.from_nix nnexp in | ||
101 | if !(opts.print_mininix_sexp) then ( | ||
102 | let mnsexp = Mininix.Sexp.expr_to_sexp mnexp in | ||
103 | print_string "==> Mininix S-expr:\n"; | ||
104 | Sexp_pretty.pp_formatter config formatter mnsexp; | ||
105 | printf "\n%!"); | ||
106 | let mnwpexp = Mininix.apply_prelude mnexp in | ||
107 | if !(opts.print_mininix_sexp_w_prelude) then ( | ||
108 | let mnwpsexp = Mininix.Sexp.expr_to_sexp mnwpexp in | ||
109 | print_string "==> Mininix S-expr (+ prelude):\n"; | ||
110 | Sexp_pretty.pp_formatter config formatter mnwpsexp; | ||
111 | printf "\n%!"); | ||
112 | let res = | ||
113 | Mininix.interp_tl ~fuel:!(opts.fuel_amount) ~mode:!(opts.eval_strategy) | ||
114 | ~imports mnwpexp | ||
115 | in | ||
116 | if !(opts.print_result_mininix_sexp) then ( | ||
117 | let ressexp = Mininix.Sexp.val_res_to_sexp res in | ||
118 | print_string "==> Evaluation result (Mininix S-exp):\n"; | ||
119 | Sexp_pretty.pp_formatter config formatter ressexp; | ||
120 | printf "\n%!"); | ||
121 | match res with | ||
122 | | Res (Some v) -> | ||
123 | let nixv = Mininix.Mininix2nix.from_val v in | ||
124 | if !(opts.print_result_nix_sexp) then ( | ||
125 | let nixvsexp = Nix.Ast.sexp_of_expr nixv in | ||
126 | print_string "==> Evaluation result (Nix S-exp):\n"; | ||
127 | Sexp_pretty.pp_formatter config formatter nixvsexp; | ||
128 | printf "\n%!"); | ||
129 | print_string "==> Evaluation result (Nix):\n"; | ||
130 | Nix.Printer.print stdout nixv; | ||
131 | printf "\n%!"; | ||
132 | true | ||
133 | | Res None -> | ||
134 | printf "Failed to evaluate\n%!"; | ||
135 | false | ||
136 | | _ -> | ||
137 | printf "Ran out of fuel\n%!"; | ||
138 | false | ||
139 | with | ||
140 | | Nix.ParseError msg -> | ||
141 | printf "Failed to parse: %s\n%!" msg; | ||
142 | false | ||
143 | | Nix.ElaborateError msg -> | ||
144 | printf "Elaboration failed: %s\n%!" msg; | ||
145 | false | ||
146 | | Mininix.Nix2mininix.FromNixError msg -> | ||
147 | printf "Failed to convert Nix to Mininix: %s\n%!" msg; | ||
148 | false | ||
149 | |||
150 | let eval_expr ~origin data = | ||
151 | match load_imports ~for_:origin with | ||
152 | | Ok imports -> eval_expr_with_imports ~origin ~imports data | ||
153 | | Error msg -> | ||
154 | print_endline msg; | ||
155 | false | ||
156 | |||
157 | let eval_ch ~origin ch = In_channel.input_all ch |> eval_expr ~origin | ||
158 | |||
159 | let eval_file filename = | ||
160 | In_channel.with_file filename ~binary:true | ||
161 | ~f:(eval_ch ~origin:(Filename filename)) | ||
162 | |||
163 | let eval_stdin () = eval_ch In_channel.stdin ~origin:Stdin | ||
diff --git a/bin/settings.ml b/bin/settings.ml new file mode 100644 index 0000000..55699ee --- /dev/null +++ b/bin/settings.ml | |||
@@ -0,0 +1,120 @@ | |||
1 | open Core | ||
2 | |||
3 | type fuel_amount = [ `Limited | `Unlimited ] | ||
4 | type eval_strategy = [ `Shallow | `Deep ] | ||
5 | |||
6 | type options = { | ||
7 | eval_strategy : eval_strategy ref; | ||
8 | fuel_amount : fuel_amount ref; | ||
9 | imports_def_file : string option ref; | ||
10 | print_input : bool ref; | ||
11 | print_parsed : bool ref; | ||
12 | print_elaborated : bool ref; | ||
13 | print_nix_sexp : bool ref; | ||
14 | print_mininix_sexp : bool ref; | ||
15 | print_mininix_sexp_w_prelude : bool ref; | ||
16 | print_result_mininix_sexp : bool ref; | ||
17 | print_result_nix_sexp : bool ref; | ||
18 | } | ||
19 | |||
20 | let opts = | ||
21 | { | ||
22 | eval_strategy = ref `Deep; | ||
23 | fuel_amount = ref `Unlimited; | ||
24 | imports_def_file = ref None; | ||
25 | print_input = ref false; | ||
26 | print_parsed = ref false; | ||
27 | print_elaborated = ref false; | ||
28 | print_nix_sexp = ref false; | ||
29 | print_mininix_sexp = ref false; | ||
30 | print_mininix_sexp_w_prelude = ref false; | ||
31 | print_result_mininix_sexp = ref false; | ||
32 | print_result_nix_sexp = ref false; | ||
33 | } | ||
34 | |||
35 | type 'a setter = 'a -> unit | ||
36 | |||
37 | type setting = | ||
38 | | BoolSetting of bool ref | ||
39 | | EvalStrategySetting of eval_strategy ref | ||
40 | | FilenameOptionSetting of string option ref | ||
41 | | FuelAmountSetting of fuel_amount ref | ||
42 | |||
43 | let allowed_values s = | ||
44 | match s with | ||
45 | | BoolSetting _ -> [ "true"; "false" ] | ||
46 | | EvalStrategySetting _ -> [ "shallow"; "deep" ] | ||
47 | | FilenameOptionSetting _ -> [ "none"; "some " ] | ||
48 | | FuelAmountSetting _ -> [ "limited"; "unlimited" ] | ||
49 | |||
50 | let set_to s v = | ||
51 | match s with | ||
52 | | BoolSetting vref -> ( | ||
53 | match v with | ||
54 | | [ "true" ] -> | ||
55 | vref := true; | ||
56 | None | ||
57 | | [ "false" ] -> | ||
58 | vref := false; | ||
59 | None | ||
60 | | _ -> Some "expected one argument: 'true' or 'false'") | ||
61 | | EvalStrategySetting vref -> ( | ||
62 | match v with | ||
63 | | [ "shallow" ] -> | ||
64 | vref := `Shallow; | ||
65 | None | ||
66 | | [ "deep" ] -> | ||
67 | vref := `Deep; | ||
68 | None | ||
69 | | _ -> Some "expected one argument: 'shallow' or 'deep'") | ||
70 | | FilenameOptionSetting vref -> ( | ||
71 | match v with | ||
72 | | [ "none" ] -> | ||
73 | vref := None; | ||
74 | None | ||
75 | | [ "some"; filename ] -> | ||
76 | vref := Some (String.strip filename); | ||
77 | None | ||
78 | | _ -> Some "expected 'none' or 'some <filename>'") | ||
79 | | FuelAmountSetting vref -> ( | ||
80 | match v with | ||
81 | | [ "limited" ] -> | ||
82 | vref := `Limited; | ||
83 | None | ||
84 | | [ "unlimited" ] -> | ||
85 | vref := `Unlimited; | ||
86 | None | ||
87 | | _ -> Some "expected 'limited' or 'unlimited'") | ||
88 | |||
89 | let to_string s = | ||
90 | match s with | ||
91 | | BoolSetting vref -> Bool.to_string !vref | ||
92 | | EvalStrategySetting vref -> ( | ||
93 | match !vref with `Shallow -> "shallow" | `Deep -> "deep") | ||
94 | | FilenameOptionSetting vref -> ( | ||
95 | match !vref with None -> "none" | Some v -> "some " ^ v) | ||
96 | | FuelAmountSetting vref -> ( | ||
97 | match !vref with `Limited -> "limited" | `Unlimited -> "unlimited") | ||
98 | |||
99 | let settings = | ||
100 | Map.of_alist_exn | ||
101 | (module String) | ||
102 | [ | ||
103 | ("print_input", BoolSetting opts.print_input); | ||
104 | ("print_parsed", BoolSetting opts.print_parsed); | ||
105 | ("print_elaborated", BoolSetting opts.print_elaborated); | ||
106 | ("print_nix_sexp", BoolSetting opts.print_nix_sexp); | ||
107 | ("print_mininix_sexp", BoolSetting opts.print_mininix_sexp); | ||
108 | ( "print_mininix_sexp_w_prelude", | ||
109 | BoolSetting opts.print_mininix_sexp_w_prelude ); | ||
110 | ("print_result_mininix_sexp", BoolSetting opts.print_result_mininix_sexp); | ||
111 | ("print_result_nix_sexp", BoolSetting opts.print_result_nix_sexp); | ||
112 | ("eval_strategy", EvalStrategySetting opts.eval_strategy); | ||
113 | ("fuel_amount", FuelAmountSetting opts.fuel_amount); | ||
114 | ("imports_def_file", FilenameOptionSetting opts.imports_def_file); | ||
115 | ] | ||
116 | |||
117 | let print () = | ||
118 | printf "==> Settings:\n"; | ||
119 | Map.iteri settings ~f:(fun ~key:name ~data:setting -> | ||
120 | printf " %s: %s\n" name (to_string setting)) | ||
diff --git a/cloc-rocq.sh b/cloc-rocq.sh new file mode 100755 index 0000000..1019af3 --- /dev/null +++ b/cloc-rocq.sh | |||
@@ -0,0 +1,150 @@ | |||
1 | #!/bin/bash | ||
2 | |||
3 | cloc --by-file ./theories --include-ext=v --json | jq -r ' | ||
4 | def categories: { | ||
5 | "./theories/lambda/operational.v": { | ||
6 | component: "(2) LambdaLang", | ||
7 | category1: "(1) Operational semantics", | ||
8 | category2: "General", | ||
9 | }, | ||
10 | "./theories/lambda/operational_props.v": { | ||
11 | component: "(2) LambdaLang", | ||
12 | category1: "(1) Operational semantics", | ||
13 | category2: "Properties", | ||
14 | }, | ||
15 | "./theories/lambda/interp.v": { | ||
16 | component: "(2) LambdaLang", | ||
17 | category1: "(2) Interpreter", | ||
18 | category2: "General", | ||
19 | }, | ||
20 | "./theories/lambda/interp_proofs.v": { | ||
21 | component: "(2) LambdaLang", | ||
22 | category1: "(2) Interpreter", | ||
23 | category2: "Theorem + proofs", | ||
24 | }, | ||
25 | "./theories/dynlang/operational.v": { | ||
26 | component: "(3) DynLang", | ||
27 | category1: "(1) Operational semantics", | ||
28 | category2: "General", | ||
29 | }, | ||
30 | "./theories/dynlang/operational_props.v": { | ||
31 | component: "(3) DynLang", | ||
32 | category1: "(1) Operational semantics", | ||
33 | category2: "Properties", | ||
34 | }, | ||
35 | "./theories/dynlang/interp.v": { | ||
36 | component: "(3) DynLang", | ||
37 | category1: "(2) Interpreter", | ||
38 | category2: "General", | ||
39 | }, | ||
40 | "./theories/dynlang/interp_proofs.v": { | ||
41 | component: "(3) DynLang", | ||
42 | category1: "(2) Interpreter", | ||
43 | category2: "Theorem + proofs", | ||
44 | }, | ||
45 | "./theories/dynlang/equiv.v": { | ||
46 | component: "(3) DynLang", | ||
47 | category1: "(4) Extra", | ||
48 | category2: "Equivalence with LambdaLang", | ||
49 | }, | ||
50 | "./theories/evallang/operational.v": { | ||
51 | component: "(4) EvalLang", | ||
52 | category1: "(1) Operational semantics", | ||
53 | category2: "General", | ||
54 | }, | ||
55 | "./theories/evallang/operational_props.v": { | ||
56 | component: "(4) EvalLang", | ||
57 | category1: "(1) Operational semantics", | ||
58 | category2: "Properties", | ||
59 | }, | ||
60 | "./theories/evallang/interp.v": { | ||
61 | component: "(4) EvalLang", | ||
62 | category1: "(2) Interpreter", | ||
63 | category2: "General", | ||
64 | }, | ||
65 | "./theories/evallang/interp_proofs.v": { | ||
66 | component: "(4) EvalLang", | ||
67 | category1: "(2) Interpreter", | ||
68 | category2: "Theorem + proofs", | ||
69 | }, | ||
70 | "./theories/evallang/tests.v": { | ||
71 | component: "(4) EvalLang", | ||
72 | category1: "(3) Tests", | ||
73 | category2: "General", | ||
74 | }, | ||
75 | "./theories/nix/floats.v": { | ||
76 | component: "(5) NixLang", | ||
77 | category1: "(4) Extra", | ||
78 | category2: "General", | ||
79 | }, | ||
80 | "./theories/nix/operational.v": { | ||
81 | component: "(5) NixLang", | ||
82 | category1: "(1) Operational semantics", | ||
83 | category2: "General", | ||
84 | }, | ||
85 | "./theories/nix/operational_props.v": { | ||
86 | component: "(5) NixLang", | ||
87 | category1: "(1) Operational semantics", | ||
88 | category2: "Properties", | ||
89 | }, | ||
90 | "./theories/nix/notations.v": { | ||
91 | component: "(5) NixLang", | ||
92 | category1: "(4) Extra", | ||
93 | category2: "General", | ||
94 | }, | ||
95 | "./theories/nix/interp.v": { | ||
96 | component: "(5) NixLang", | ||
97 | category1: "(2) Interpreter", | ||
98 | category2: "General", | ||
99 | }, | ||
100 | "./theories/nix/interp_proofs.v": { | ||
101 | component: "(5) NixLang", | ||
102 | category1: "(2) Interpreter", | ||
103 | category2: "Theorem + proofs", | ||
104 | }, | ||
105 | "./theories/nix/tests.v": { | ||
106 | component: "(5) NixLang", | ||
107 | category1: "(3) Tests", | ||
108 | category2: "General", | ||
109 | }, | ||
110 | "./theories/nix/wp.v": { | ||
111 | component: "(5) NixLang", | ||
112 | category1: "(4) Extra", | ||
113 | category2: "General", | ||
114 | }, | ||
115 | "./theories/nix/wp_examples.v": { | ||
116 | component: "(5) NixLang", | ||
117 | category1: "(4) Extra", | ||
118 | category2: "General", | ||
119 | }, | ||
120 | "./theories/utils.v": { | ||
121 | component: "(1) Shared", | ||
122 | category1: "General", | ||
123 | category2: "General", | ||
124 | }, | ||
125 | "./theories/res.v": { | ||
126 | component: "(1) Shared", | ||
127 | category1: "General", | ||
128 | category2: "General", | ||
129 | }, | ||
130 | }; | ||
131 | def add_cat_data: | ||
132 | { key, value: ({loc: .value.code} + categories[.key]) }; | ||
133 | def categorize_by(key): | ||
134 | group_by(.value[key]) | map({ key: .[0].value[key], value: . }) | from_entries; | ||
135 | def spaces: if . == 0 then "" else " " + (. - 1 | spaces) end; | ||
136 | def pretty(ind): | ||
137 | if (. | type) == "number" then | ||
138 | . | tostring | ||
139 | else | ||
140 | to_entries | reduce .[] as $item (""; . + "\n" + (ind | spaces) + $item.key + ": " + ($item.value | pretty(ind + 2))) | ||
141 | end; | ||
142 | .SUM.code as $sum | del(.header, .SUM) | with_entries(add_cat_data) | to_entries | ||
143 | | categorize_by("component") | map_values(categorize_by("category1")) | ||
144 | | map_values(map_values(categorize_by("category2") | map_values(map(.value.loc) | add))) | ||
145 | | map_values(map_values(. + { TOTAL: to_entries | map(.value) | add })) | ||
146 | | map_values(. + { TOTAL: to_entries | map(.value.TOTAL) | add }) | ||
147 | | . + { TOTAL: to_entries | map(.value.TOTAL) | add } | ||
148 | | if .TOTAL == $sum then . else error("internal error: calculated total \(.TOTAL) does not match provided sum \($sum)") end | ||
149 | | "Lines of code for the different parts of the Rocq development:" + pretty(0) | ||
150 | ' | ||
diff --git a/cloc.nix b/cloc.nix new file mode 100644 index 0000000..07a3692 --- /dev/null +++ b/cloc.nix | |||
@@ -0,0 +1,16 @@ | |||
1 | { pkgs ? import ./nixpkgs-pinned.nix {} }: | ||
2 | pkgs.stdenv.mkDerivation { | ||
3 | name = "mininix-cloc"; | ||
4 | src = ./.; | ||
5 | |||
6 | nativeBuildInputs = with pkgs; [ cloc jq ]; | ||
7 | |||
8 | buildPhase = '' | ||
9 | bash cloc-rocq.sh > formalization-loc-report | ||
10 | ''; | ||
11 | |||
12 | installPhase = '' | ||
13 | mkdir -p $out | ||
14 | cp formalization-loc-report $out/ | ||
15 | ''; | ||
16 | } | ||
diff --git a/coverage.nix b/coverage.nix new file mode 100644 index 0000000..ed03ce8 --- /dev/null +++ b/coverage.nix | |||
@@ -0,0 +1,19 @@ | |||
1 | { pkgs ? import ./nixpkgs-pinned.nix {} }: | ||
2 | (import ./default.nix { inherit pkgs; }).overrideAttrs (final: prev: { | ||
3 | name = "mininix-coverage"; | ||
4 | |||
5 | nativeBuildInputs = prev.nativeBuildInputs ++ [ | ||
6 | pkgs.ocaml-ng.ocamlPackages_4_14.bisect_ppx | ||
7 | ]; | ||
8 | |||
9 | checkPhase = '' | ||
10 | dune test --instrument-with bisect_ppx --force | ||
11 | ''; | ||
12 | |||
13 | installPhase = '' | ||
14 | mkdir -p $out/coverage | ||
15 | bisect-ppx-report summary --per-file > $out/coverage/report-plain | ||
16 | bisect-ppx-report html | ||
17 | cp -R _coverage $out/coverage/html/ | ||
18 | ''; | ||
19 | }) | ||
diff --git a/coverage.sh b/coverage.sh new file mode 100755 index 0000000..10fdf37 --- /dev/null +++ b/coverage.sh | |||
@@ -0,0 +1,9 @@ | |||
1 | #!/bin/bash | ||
2 | |||
3 | rm -rf _coverage | ||
4 | echo "Running tests" | ||
5 | dune test --instrument-with bisect_ppx --force | ||
6 | echo "Generating report" | ||
7 | bisect-ppx-report html | ||
8 | bisect-ppx-report summary --per-file | ||
9 | echo "See lib/extraction/interp.ml above or see the detailed report (in HTML form) at _coverage/html/lib/extraction/interp.ml.html" | ||
diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..8f68fe8 --- /dev/null +++ b/default.nix | |||
@@ -0,0 +1,27 @@ | |||
1 | { pkgs ? import ./nixpkgs-pinned.nix {} }: with pkgs; | ||
2 | let ocamlPackages = ocaml-ng.ocamlPackages_4_14; in | ||
3 | |||
4 | ocamlPackages.buildDunePackage { | ||
5 | pname = "mininix"; | ||
6 | version = "1.0.0"; | ||
7 | |||
8 | src = ./.; | ||
9 | doCheck = true; | ||
10 | |||
11 | nativeBuildInputs = [ coq_8_20 git ocamlPackages.menhir ]; | ||
12 | buildInputs = (with coqPackages_8_20; [ | ||
13 | flocq | ||
14 | stdpp | ||
15 | ]) ++ (with ocamlPackages; [ | ||
16 | bisect_ppx | ||
17 | core | ||
18 | core_unix | ||
19 | linenoise | ||
20 | pprint | ||
21 | ppx_blob | ||
22 | ppx_let | ||
23 | ppx_sexp_conv | ||
24 | sexp_pretty | ||
25 | stdio | ||
26 | ]); | ||
27 | } | ||
diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..32c81cd --- /dev/null +++ b/dune-project | |||
@@ -0,0 +1,22 @@ | |||
1 | (lang dune 3.15) | ||
2 | |||
3 | (name mininix) | ||
4 | |||
5 | (generate_opam_files true) | ||
6 | |||
7 | (using menhir 3.0) | ||
8 | (using coq 0.8) | ||
9 | |||
10 | (authors "Rutger Broekhoff" "Robbert Krebbers") | ||
11 | |||
12 | (license LICENSE) | ||
13 | |||
14 | (package | ||
15 | (name mininix) | ||
16 | (depends (ocaml (< 5)) | ||
17 | (coq (and (>= 8.20) (< 8.21))) | ||
18 | (coq-stdpp (and (>= 1.11) (< 1.12))) | ||
19 | coq-flocq | ||
20 | core core_unix linenoise menhir pprint sexp_pretty stdio | ||
21 | ppx_sexp_conv ppx_blob ppx_let bisect_ppx | ||
22 | (merlin :dev) (ocamlformat :dev))) | ||
diff --git a/explorer/.gitignore b/explorer/.gitignore new file mode 100644 index 0000000..94529d8 --- /dev/null +++ b/explorer/.gitignore | |||
@@ -0,0 +1,2 @@ | |||
1 | dest/ | ||
2 | dest-*/ | ||
diff --git a/explorer/generate.sh b/explorer/generate.sh new file mode 100755 index 0000000..cf2b77a --- /dev/null +++ b/explorer/generate.sh | |||
@@ -0,0 +1,140 @@ | |||
1 | #!/bin/bash | ||
2 | |||
3 | shopt -s globstar | ||
4 | set -eu | ||
5 | set -o pipefail | ||
6 | |||
7 | rm -rf dest | ||
8 | mkdir -p dest | ||
9 | TREE="$(pwd)/tree.sh" | ||
10 | destdir="$(pwd)/dest" | ||
11 | commit="$(git rev-parse --short HEAD)" | ||
12 | |||
13 | cd ../theories | ||
14 | for file in **/*.v; do | ||
15 | destfile="$destdir/$file.html" | ||
16 | mkdir -p "$(dirname "$destfile")" | ||
17 | echo "<!DOCTYPE html> | ||
18 | <html lang=\"en\"> | ||
19 | <head> | ||
20 | <meta charset=\"UTF-8\"> | ||
21 | <title>$file</title> | ||
22 | <style>" >> "$destfile" | ||
23 | python -m pygments -S default -f html >> "$destfile" | ||
24 | echo " | ||
25 | html { height: 100%; } | ||
26 | body { | ||
27 | font-family: sans-serif; | ||
28 | margin: 0px; | ||
29 | min-height: 100%; | ||
30 | display: flex; | ||
31 | flex-direction: column; | ||
32 | } | ||
33 | header { | ||
34 | display: flex; | ||
35 | padding: 0em 1em; | ||
36 | border-bottom: 1px solid black; | ||
37 | } | ||
38 | nav { | ||
39 | width: 200px; | ||
40 | border-right: 1px solid black; | ||
41 | min-height: 100%; | ||
42 | } | ||
43 | nav ul { | ||
44 | list-style-type: none; | ||
45 | padding-left: 1em; | ||
46 | } | ||
47 | nav ul:not(#top-dir) { | ||
48 | border-left: 1px solid black; | ||
49 | } | ||
50 | nav li { | ||
51 | font-family: monospace; | ||
52 | } | ||
53 | a { text-decoration: none; } | ||
54 | a.current { font-weight: bold; } | ||
55 | .row { display: flex; } | ||
56 | .grow { flex-grow: 1; } | ||
57 | .h1-like { | ||
58 | display: block; | ||
59 | margin-block: 0.67em; | ||
60 | font-size: 2.00em; | ||
61 | font-weight: bold; | ||
62 | } | ||
63 | #subtitle { | ||
64 | display: block; | ||
65 | margin-block: 0.83em; | ||
66 | font-size: 1.50em; | ||
67 | } | ||
68 | </style> | ||
69 | </head> | ||
70 | <body> | ||
71 | <header class=\"row\"> | ||
72 | <div class=\"grow\"> | ||
73 | <h1>Verified Interpreters for Dynamic Languages</h1> | ||
74 | <span id=\"subtitle\">with Applications to the Nix Expression Language</span> | ||
75 | </div> | ||
76 | <div> | ||
77 | <span class=\"h1-like\">Rocq Mechanization</span> | ||
78 | <span>Commit $commit</span> | ||
79 | </div> | ||
80 | </header> | ||
81 | <div class=\"row grow\"> | ||
82 | <nav> | ||
83 | <ul id=\"top-dir\"> | ||
84 | " >> "$destfile" | ||
85 | $TREE "$file" >> "$destfile" | ||
86 | echo ' | ||
87 | </ul> | ||
88 | </nav> | ||
89 | <main class="grow">' >> "$destfile" | ||
90 | python -m pygments -fhtml -lcoq -Oanchorlinenos,linenos,linespans=line "$file" >> "$destfile" | ||
91 | echo ' | ||
92 | </main> | ||
93 | </div> | ||
94 | <script> | ||
95 | function highlightOne(lineno) { | ||
96 | let el = document.getElementById("line-" + lineno); | ||
97 | el.classList.add("hll"); | ||
98 | } | ||
99 | |||
100 | function scrollTo(lineno) { | ||
101 | let el = document.getElementById("line-" + lineno); | ||
102 | el.scrollIntoView(); | ||
103 | } | ||
104 | |||
105 | function highlight() { | ||
106 | let frag = window.location.hash.substring(1); | ||
107 | if (/^line-[0-9]+$/.test(frag)) { | ||
108 | highlightOne(frag.substring(5)); | ||
109 | scrollTo(frag.substring(5)); | ||
110 | } else if (/^L[0-9]+$/.test(frag)) { | ||
111 | highlightOne(frag.substring(1)); | ||
112 | scrollTo(frag.substring(1)); | ||
113 | } else if (/^L[0-9]+-L[0-9]+$/.test(frag)) { | ||
114 | let matches = frag.match(/[0-9]+/g); | ||
115 | let startLineno = Number(matches[0]); | ||
116 | let endLineno = Number(matches[1]); | ||
117 | for (let lineno = startLineno; lineno <= endLineno; lineno++) { | ||
118 | highlightOne(lineno); | ||
119 | } | ||
120 | scrollTo(startLineno); | ||
121 | } | ||
122 | } | ||
123 | |||
124 | function unhighlight() { | ||
125 | for (const el of Array.from(document.getElementsByClassName("hll"))) { | ||
126 | el.classList.remove("hll"); | ||
127 | } | ||
128 | } | ||
129 | |||
130 | function rehighlight() { | ||
131 | unhighlight(); | ||
132 | highlight(); | ||
133 | } | ||
134 | |||
135 | window.addEventListener("hashchange", rehighlight); | ||
136 | window.addEventListener("load", highlight); | ||
137 | </script> | ||
138 | </body> | ||
139 | </html>' >> "$destfile" | ||
140 | done | ||
diff --git a/explorer/tree.sh b/explorer/tree.sh new file mode 100755 index 0000000..1620d2d --- /dev/null +++ b/explorer/tree.sh | |||
@@ -0,0 +1,17 @@ | |||
1 | #!/bin/bash | ||
2 | |||
3 | tree -J ../theories -P "*.v" | jq --arg "current" "$1" -r ' | ||
4 | ("../" * ($current | [ scan("/+") ] | length)) as $prefix | | ||
5 | def make_item_link(prefix): | ||
6 | (if $current == prefix + .name then " class=\"current\"" else "" end) as $extra | | ||
7 | "<a href=\"\($prefix)\(prefix)\(.name | @uri).html\"\($extra)>\(.name | @html)</a>"; | ||
8 | def handle_item(prefix): | ||
9 | if .type == "directory" then | ||
10 | "<li>\(.name | @html)<ul>" + | ||
11 | (.name as $dir | .contents | map(handle_item("\(prefix)\($dir)/")) | add) + | ||
12 | "</ul></li>" | ||
13 | else | ||
14 | "<li>\(make_item_link(prefix))</li>" | ||
15 | end; | ||
16 | .[0].contents | map(handle_item("")) | add | ||
17 | ' | ||
diff --git a/explorer/upload-new.sh b/explorer/upload-new.sh new file mode 100755 index 0000000..7873aa2 --- /dev/null +++ b/explorer/upload-new.sh | |||
@@ -0,0 +1,16 @@ | |||
1 | #!/bin/bash | ||
2 | |||
3 | set -eu | ||
4 | set -o pipefail | ||
5 | |||
6 | commit="$(git rev-parse --short HEAD)" | ||
7 | |||
8 | [ -e "dest-$commit" ] && { | ||
9 | echo "Revision $commit may have already been uploaded. Delete the directory dest-$commit to force re-upload."; | ||
10 | exit 1 | ||
11 | } | ||
12 | |||
13 | ./generate.sh | ||
14 | mv dest "dest-$commit" | ||
15 | mcli cp --recursive --checksum sha256 dest-$commit/* s3-default-par/verified-dyn-lang-interp/$commit/theories/ | ||
16 | echo "Base URL (for \\rocqbaseurl): https://s3.fr-par.scw.cloud/verified-dyn-lang-interp/$commit/" | ||
diff --git a/importdef.sexp b/importdef.sexp new file mode 100644 index 0000000..2d11aed --- /dev/null +++ b/importdef.sexp | |||
@@ -0,0 +1 @@ | |||
(deps test/testdata/lib.nix) | |||
diff --git a/lib/extraction/dune b/lib/extraction/dune new file mode 100644 index 0000000..b56caf9 --- /dev/null +++ b/lib/extraction/dune | |||
@@ -0,0 +1,56 @@ | |||
1 | (coq.extraction | ||
2 | (prelude prelude) | ||
3 | (extracted_modules | ||
4 | Ascii | ||
5 | BinInt | ||
6 | Bits | ||
7 | Decimal | ||
8 | prelude | ||
9 | gmap | ||
10 | Nat | ||
11 | PeanoNat | ||
12 | SpecFloat | ||
13 | ZArith_dec | ||
14 | base | ||
15 | BinNat | ||
16 | Bool | ||
17 | DecimalString | ||
18 | interp | ||
19 | numbers | ||
20 | pretty | ||
21 | Specif | ||
22 | Zbool | ||
23 | Basics | ||
24 | BinNums | ||
25 | countable | ||
26 | list0 | ||
27 | operational | ||
28 | res | ||
29 | String | ||
30 | Zpower | ||
31 | Binary | ||
32 | BinPosDef | ||
33 | Datatypes | ||
34 | fin_maps | ||
35 | List | ||
36 | option | ||
37 | Round | ||
38 | strings | ||
39 | BinarySingleNaN | ||
40 | BinPos | ||
41 | decidable | ||
42 | floats | ||
43 | mapset | ||
44 | orders | ||
45 | sorting | ||
46 | utils) | ||
47 | (flags | ||
48 | (-output-directory ".")) | ||
49 | (theories Flocq stdpp mininix)) | ||
50 | |||
51 | (library | ||
52 | (name extraction) | ||
53 | (flags | ||
54 | (:standard -w -33)) | ||
55 | (instrumentation | ||
56 | (backend bisect_ppx))) | ||
diff --git a/lib/extraction/extraction.ml b/lib/extraction/extraction.ml new file mode 100644 index 0000000..a737700 --- /dev/null +++ b/lib/extraction/extraction.ml | |||
@@ -0,0 +1,18 @@ | |||
1 | include Prelude | ||
2 | include Interp | ||
3 | include Operational | ||
4 | include Res | ||
5 | |||
6 | (* Stuff that's not part of the paper. Still exposed because we sometimes want | ||
7 | to be able to create a natural number, float, process a list etc. *) | ||
8 | module Internal = struct | ||
9 | module BinNums = BinNums | ||
10 | module Datatypes = Datatypes | ||
11 | module List = List | ||
12 | |||
13 | module Floats = struct | ||
14 | include Floats | ||
15 | include Binary | ||
16 | include SpecFloat | ||
17 | end | ||
18 | end | ||
diff --git a/lib/extraction/prelude.v b/lib/extraction/prelude.v new file mode 100644 index 0000000..ef35bcb --- /dev/null +++ b/lib/extraction/prelude.v | |||
@@ -0,0 +1,52 @@ | |||
1 | Require Import Coq.Numbers.DecimalString ExtrOcamlBasic ExtrOcamlString. | ||
2 | From stdpp Require Import strings stringmap gmap. | ||
3 | From mininix Require Import nix.interp. | ||
4 | |||
5 | Definition attr_set_insert (x : string) (α : attr) (αs : gmap string attr) : gmap string attr := | ||
6 | <[x:=α]> αs. | ||
7 | |||
8 | Definition attr_set_contains (x : string) (αs : gmap string attr) : bool := | ||
9 | bool_decide (x ∈ dom αs). | ||
10 | |||
11 | Definition attr_set_fold {A} (f : string → attr → A → A) (init : A) (αs : gmap string attr) : A := | ||
12 | map_fold f init αs. | ||
13 | |||
14 | Definition attr_set_empty : gmap string attr := ∅. | ||
15 | |||
16 | Definition env_fold {A} (f : string → (kind * thunk) → A → A) (init : A) (E : env) : A := | ||
17 | map_fold f init E. | ||
18 | |||
19 | Definition env_insert_abs (x : string) (t : thunk) (E : env) : env := | ||
20 | <[x:=(ABS,t)]> E. | ||
21 | |||
22 | Definition thunk_map_fold {A} (f : string → thunk → A → A) (init : A) (bs : gmap string thunk) : A := | ||
23 | map_fold f init bs. | ||
24 | |||
25 | Definition thunk_map_insert (x : string) (t : thunk) (bs : gmap string thunk) : gmap string thunk := | ||
26 | <[x:=t]> bs. | ||
27 | |||
28 | Definition thunk_map_empty : gmap string thunk := ∅. | ||
29 | |||
30 | Definition matcher := gmap string (option expr). | ||
31 | |||
32 | Definition matcher_empty : matcher := ∅. | ||
33 | |||
34 | Definition matcher_insert (x : string) (me : option expr) (ms : matcher) : matcher := | ||
35 | <[x:=me]> ms. | ||
36 | |||
37 | Definition matcher_fold {A} (f : string → option expr → A → A) (init : A) (ms : matcher) : A := | ||
38 | map_fold f init ms. | ||
39 | |||
40 | Definition env_empty : env := ∅. | ||
41 | |||
42 | Definition string_of_Z (x : Z) : string := | ||
43 | NilZero.string_of_int (Z.to_int x). | ||
44 | |||
45 | Definition string_to_Z (s : string) : option Z := | ||
46 | Z.of_int <$> NilZero.int_of_string s. | ||
47 | |||
48 | Separate Extraction | ||
49 | attr_set_insert env_insert_abs matcher_insert thunk_map_insert | ||
50 | attr_set_contains attr_set_fold env_fold matcher_fold thunk_map_fold | ||
51 | env_empty attr_set_empty matcher_empty thunk_map_empty string_of_Z | ||
52 | string_to_Z interp' forallb. | ||
diff --git a/lib/mininix/builtins.ml b/lib/mininix/builtins.ml new file mode 100644 index 0000000..0809668 --- /dev/null +++ b/lib/mininix/builtins.ml | |||
@@ -0,0 +1,77 @@ | |||
1 | open Core | ||
2 | open Nix2mininix | ||
3 | |||
4 | let minimal_prelude = | ||
5 | mn_attr | ||
6 | [ | ||
7 | ("true", `Nonrec, Extraction.ELit (Extraction.LitBool true)); | ||
8 | ("false", `Nonrec, Extraction.ELit (Extraction.LitBool false)); | ||
9 | ("null", `Nonrec, Extraction.ELit Extraction.LitNull); | ||
10 | ("seq", `Nonrec, mn_abs [ "e1"; "e2" ] (mn_seq (mn_id "e1") (mn_id "e2"))); | ||
11 | ( "deepSeq", | ||
12 | `Nonrec, | ||
13 | mn_abs [ "e1"; "e2" ] (mn_deep_seq (mn_id "e1") (mn_id "e2")) ); | ||
14 | ("typeOf", `Nonrec, mn_abs [ "e" ] (mn_type_of (mn_id "e"))); | ||
15 | ("functionArgs", `Nonrec, mn_abs [ "f" ] (mn_function_args (mn_id "f"))); | ||
16 | ( "bitAnd", | ||
17 | `Nonrec, | ||
18 | mn_abs [ "x"; "y" ] (mn_bit_and (mn_id "x") (mn_id "y")) ); | ||
19 | ("bitOr", `Nonrec, mn_abs [ "x"; "y" ] (mn_bit_or (mn_id "x") (mn_id "y"))); | ||
20 | ( "bitXor", | ||
21 | `Nonrec, | ||
22 | mn_abs [ "x"; "y" ] (mn_bit_xor (mn_id "x") (mn_id "y")) ); | ||
23 | ("ceil", `Nonrec, mn_abs [ "x" ] (mn_ceil (mn_id "x"))); | ||
24 | ("floor", `Nonrec, mn_abs [ "x" ] (mn_floor (mn_id "x"))); | ||
25 | ("__mn_nearestEven", `Nonrec, mn_abs [ "x" ] (mn_nearest_even (mn_id "x"))); | ||
26 | ( "__mn_singleton", | ||
27 | `Nonrec, | ||
28 | mn_abs [ "x"; "e" ] (mn_singleton_attr (mn_id "x") (mn_id "e")) ); | ||
29 | ( "__mn_attr_delete", | ||
30 | `Nonrec, | ||
31 | mn_abs [ "as"; "x" ] (mn_delete_attr (mn_id "as") (mn_id "x")) ); | ||
32 | ( "__mn_attr_has_prim", | ||
33 | `Nonrec, | ||
34 | mn_abs [ "d"; "e" ] (mn_has_attr (mn_id "d") (mn_id "e")) ); | ||
35 | ("__mn_attr_match", `Nonrec, mn_abs [ "as" ] (mn_attr_match (mn_id "as"))); | ||
36 | ("__mn_list_match", `Nonrec, mn_abs [ "xs" ] (mn_list_match (mn_id "xs"))); | ||
37 | ( "__mn_string_match", | ||
38 | `Nonrec, | ||
39 | mn_abs [ "s" ] (mn_string_match (mn_id "s")) ); | ||
40 | ] | ||
41 | |||
42 | (* Watch out to not introduce constructs here that refer to themselves using | ||
43 | the mnbi_* functions in Nix2mininix - this can cause undesired loops. *) | ||
44 | let builtins_nix = | ||
45 | Nix.elaborate (Nix.parse ~filename:"<builtins>" [%blob "builtins.nix"]) | ||
46 | |||
47 | let builtins = | ||
48 | Extraction.ELetAttr | ||
49 | (Extraction.ABS, minimal_prelude, Nix2mininix.from_nix builtins_nix) | ||
50 | |||
51 | let exported_builtins = | ||
52 | [ | ||
53 | "__mn_assert"; | ||
54 | "__mn_attr_has"; | ||
55 | "__mn_attr_insertNew"; | ||
56 | "__mn_attr_select"; | ||
57 | "__mn_attr_selectOr"; | ||
58 | "abort"; | ||
59 | "false"; | ||
60 | "head"; | ||
61 | "map"; | ||
62 | "null"; | ||
63 | "removeAttrs"; | ||
64 | "tail"; | ||
65 | "throw"; | ||
66 | "toString"; | ||
67 | "true"; | ||
68 | ] | ||
69 | |||
70 | let apply_prelude e = | ||
71 | let bindings = | ||
72 | mn_attr | ||
73 | (("builtins", `Nonrec, builtins) | ||
74 | :: List.map exported_builtins ~f:(fun x -> | ||
75 | (x, `Rec, mn_select_attr (mn_id "builtins") (mn_str x)))) | ||
76 | in | ||
77 | Extraction.ELetAttr (Extraction.ABS, bindings, e) | ||
diff --git a/lib/mininix/builtins.nix b/lib/mininix/builtins.nix new file mode 100644 index 0000000..9c7ed32 --- /dev/null +++ b/lib/mininix/builtins.nix | |||
@@ -0,0 +1,302 @@ | |||
1 | rec { | ||
2 | inherit true false null functionArgs typeOf seq deepSeq bitAnd bitOr bitXor floor ceil; # from the minimal prelude | ||
3 | |||
4 | abort = _: null null; # we ignore the provided message | ||
5 | throw = abort; # same here | ||
6 | |||
7 | head = xs: (__mn_list_match xs).head; | ||
8 | tail = xs: (__mn_list_match xs).tail; | ||
9 | |||
10 | __mn_matchAttr = f: as: f (__mn_attr_match as); | ||
11 | __mn_matchList = f: xs: f (__mn_list_match xs); | ||
12 | __mn_matchString = f: s: f (__mn_string_match s); | ||
13 | |||
14 | __mn_foldr = op: nul: | ||
15 | __mn_matchList ({ head, tail, empty }: | ||
16 | if empty then nul else op head (__mn_foldr op nul tail)); | ||
17 | |||
18 | # foldl' should really be strict. But if we do that (using seq), the | ||
19 | # complexity of this function suddenly morphs from linear to | ||
20 | # exponential, which is way worse than not actually being strict. | ||
21 | foldl' = op: nul: | ||
22 | __mn_matchList | ||
23 | ({ head, tail, empty }: | ||
24 | if empty then nul else | ||
25 | let v = op nul head; in | ||
26 | seq v (foldl' op v tail)); | ||
27 | map = f: | ||
28 | __mn_matchList ({ head, tail, empty }: | ||
29 | if empty then [ ] else [ (f head) ] ++ map f tail); | ||
30 | elem = x: any (y: x == y); | ||
31 | elemAt = xs: n: assert n >= 0; | ||
32 | let go = xs: n: if n == 0 then head xs else go (tail xs) (n - 1); | ||
33 | in go xs n; | ||
34 | length = __mn_matchList ({ head, tail, empty }: | ||
35 | if empty then 0 else 1 + length tail); | ||
36 | sort = __mn_mergesort; | ||
37 | any = f: __mn_matchList ({ head, tail, empty }: !empty && (f head || any f tail)); | ||
38 | all = f: __mn_matchList ({ head, tail, empty }: !empty -> (f head && all f tail)); | ||
39 | concatLists = | ||
40 | __mn_matchList ({ head, tail, empty }: | ||
41 | if empty then [ ] else head ++ concatLists tail); | ||
42 | concatMap = f: xss: concatLists (map f xss); | ||
43 | concatStringsSep = sep: | ||
44 | __mn_matchList ({ head, tail, empty }: | ||
45 | if empty then "" else if tail == [ ] then head | ||
46 | else head + sep + concatStringsSep sep tail); | ||
47 | filter = f: | ||
48 | __mn_matchList ({ head, tail, empty }: | ||
49 | if empty then [ ] else (if f head then [ head ] else [ ]) ++ filter f tail); | ||
50 | groupBy = f: xs: | ||
51 | let update = x: acc: acc // { ${f x} = [ x ] ++ (acc.${f x} or [ ]); }; | ||
52 | in __mn_foldr update { } xs; | ||
53 | partition = f: groupBy (x: if f x then "right" else "wrong"); | ||
54 | |||
55 | hasAttr = x: as: as ? ${x}; | ||
56 | getAttr = x: as: as.${x}; | ||
57 | attrNames = __mn_matchAttr ({ key, tail, empty, ... }: | ||
58 | if empty then [ ] else [ key ] ++ attrNames tail); | ||
59 | attrValues = __mn_matchAttr ({ head, tail, empty, ... }: | ||
60 | if empty then [ ] else [ head ] ++ attrValues tail); | ||
61 | mapAttrs = f: __mn_matchAttr ({ key, head, tail, empty }: | ||
62 | if empty then { } else | ||
63 | mapAttrs f tail // { ${key} = f key head; }); | ||
64 | removeAttrs = __mn_foldr (x: as': __mn_attr_delete as' x); | ||
65 | zipAttrsWith = f: ass: mapAttrs f (__mn_zipAttrs ass); | ||
66 | catAttrs = x: | ||
67 | __mn_matchList ({ head, tail, empty }: | ||
68 | if empty then [ ] | ||
69 | else (if head ? ${x} then [ head.${x} ] else [ ]) ++ catAttrs x tail); | ||
70 | listToAttrs = | ||
71 | __mn_foldr (attr: as': as' // { ${attr.name} = attr.value; }) { }; | ||
72 | intersectAttrs = e1: e2: | ||
73 | __mn_matchAttr | ||
74 | ({ key, head, tail, empty }: | ||
75 | if empty then { } else | ||
76 | (if e2 ? ${key} then { ${key} = e2.${key}; } else { }) // | ||
77 | intersectAttrs tail (__mn_attr_delete e2 key)) | ||
78 | e1; | ||
79 | |||
80 | lessThan = x: y: x < y; # documentation is misleading, not only for numbers | ||
81 | add = x: y: x + y; | ||
82 | mul = x: y: x * y; | ||
83 | div = x: y: x / y; | ||
84 | sub = x: y: x - y; | ||
85 | genList = gen: n: | ||
86 | let | ||
87 | aux = off: if off >= n then [ ] else | ||
88 | [ (gen off) ] ++ aux (off + 1); | ||
89 | in | ||
90 | aux 0; | ||
91 | |||
92 | __mn_genericClosure = { operator, seen, startSet }: | ||
93 | __mn_matchList | ||
94 | ({ head, tail, empty }: | ||
95 | if empty then [ ] else | ||
96 | if seen head.key | ||
97 | then __mn_genericClosure { inherit operator seen; startSet = tail; } | ||
98 | else [ head ] ++ __mn_genericClosure { | ||
99 | inherit operator; | ||
100 | seen = k: k == head.key || seen k; | ||
101 | startSet = tail ++ operator head; | ||
102 | }) | ||
103 | startSet; | ||
104 | genericClosure = { operator, startSet }: | ||
105 | __mn_genericClosure { inherit operator startSet; seen = _: false; }; | ||
106 | |||
107 | isAttrs = e: typeOf e == "set"; | ||
108 | isBool = e: typeOf e == "bool"; | ||
109 | isFloat = e: typeOf e == "float"; | ||
110 | isFunction = e: typeOf e == "lambda"; | ||
111 | isInt = e: typeOf e == "int"; | ||
112 | isList = e: typeOf e == "list"; | ||
113 | isNull = e: typeOf e == "null"; | ||
114 | isString = e: typeOf e == "string"; | ||
115 | |||
116 | toString = e: | ||
117 | if isAttrs e then | ||
118 | if e ? __toString then e.__toString e else e.outPath | ||
119 | else if isBool e then | ||
120 | if e then "1" else "" | ||
121 | else if isFloat e then | ||
122 | __mn_float_toString e | ||
123 | else if isInt e then | ||
124 | __mn_int_toString e | ||
125 | else if isList e then | ||
126 | concatStringsSep " " (map toString e) | ||
127 | else if isNull e then | ||
128 | "" | ||
129 | else if isString e then | ||
130 | e | ||
131 | else abort null; | ||
132 | |||
133 | stringLength = | ||
134 | __mn_matchString ({ head, tail, empty }: | ||
135 | if empty then 0 else 1 + stringLength tail); | ||
136 | |||
137 | substring = start: assert start >= 0; len: | ||
138 | __mn_matchString ({ head, tail, empty }: | ||
139 | if empty || len == 0 then "" else | ||
140 | if start > 0 | ||
141 | then substring (start - 1) len tail | ||
142 | else head + substring 0 (len - 1) tail); | ||
143 | |||
144 | replaceStrings = from: to: s: | ||
145 | __mn_matchList | ||
146 | ({ head, tail, empty }: | ||
147 | let from = if empty then [ ] else [ head ] ++ tail; in | ||
148 | __mn_matchList | ||
149 | ({ head, tail, empty }: | ||
150 | let to = if empty then [ ] else [ head ] ++ tail; in | ||
151 | assert length from == length to; | ||
152 | __mn_strings_replace from to s) | ||
153 | to) | ||
154 | from; | ||
155 | |||
156 | __mn_strings_replace = subsFrom: subsTo: s: | ||
157 | let go = __mn_strings_replace subsFrom subsTo; in | ||
158 | __mn_strings_replace_aux go subsFrom subsTo s; | ||
159 | |||
160 | __mn_strings_replace_aux = go: subsFrom: subsTo: s: | ||
161 | __mn_matchList | ||
162 | ({ head, tail, empty }: | ||
163 | if empty | ||
164 | then | ||
165 | __mn_matchString | ||
166 | ({ head, tail, empty }: if empty then "" else head + go tail) | ||
167 | s | ||
168 | else | ||
169 | let subFrom = head; subsFrom' = tail; in | ||
170 | __mn_matchList | ||
171 | ({ head, tail, ... }: | ||
172 | let subTo = head; subsTo' = tail; in | ||
173 | if subFrom == "" | ||
174 | then | ||
175 | # We can only ask ourselves why, but it is so -- in Nix: | ||
176 | # replaceStrings ["" "a"] ["X" "_"] "asdf" ~> "XaXsXdXfX" | ||
177 | # and so we emulate this 'behavior' | ||
178 | subTo + __mn_matchString | ||
179 | ({ head, tail, empty }: | ||
180 | if empty then "" else head + go tail) | ||
181 | s | ||
182 | else | ||
183 | ({ ok, rest }: | ||
184 | if ok | ||
185 | then subTo + go rest | ||
186 | else __mn_strings_replace_aux go subsFrom' subsTo' s) | ||
187 | (__mn_string_chopPrefix subFrom s)) | ||
188 | subsTo) | ||
189 | subsFrom; | ||
190 | |||
191 | __mn_string_chopPrefix = prefix: s: | ||
192 | __mn_matchString | ||
193 | ({ head, tail, empty }: | ||
194 | if empty then { ok = true; rest = s; } else | ||
195 | let prefix = head; prefix' = tail; in __mn_matchString | ||
196 | ({ head, tail, empty }: | ||
197 | if empty || prefix != head then { ok = false; rest = null; } else | ||
198 | __mn_string_chopPrefix prefix' tail) | ||
199 | s) | ||
200 | prefix; | ||
201 | |||
202 | __mn_string_drop = n: s: | ||
203 | if n <= 0 then s else | ||
204 | __mn_matchString | ||
205 | ({ tail, empty, ... }: | ||
206 | if empty then "" else | ||
207 | __mn_string_drop (n - 1) tail) | ||
208 | s; | ||
209 | |||
210 | __mn_float_toString = x: | ||
211 | let | ||
212 | sign = x < 0; | ||
213 | abs = __mn_abs x; | ||
214 | int = floor abs; | ||
215 | dec = __mn_nearestEven ((abs - int) * 1000000); | ||
216 | in | ||
217 | (if sign then "-" else "") + | ||
218 | __mn_int_toString int + "." + __mn_int_toString dec; | ||
219 | __mn_int_toString = x: (if x < 0 then "-" else "") + | ||
220 | ( | ||
221 | let d10 = __mn_quotRem (__mn_abs x) 10; in | ||
222 | (if d10.quot != 0 then toString d10.quot else "") + | ||
223 | (if d10.rem == 0 then "0" else | ||
224 | if d10.rem == 1 then "1" else | ||
225 | if d10.rem == 2 then "2" else | ||
226 | if d10.rem == 3 then "3" else | ||
227 | if d10.rem == 4 then "4" else | ||
228 | if d10.rem == 5 then "5" else | ||
229 | if d10.rem == 6 then "6" else | ||
230 | if d10.rem == 7 then "7" else | ||
231 | if d10.rem == 8 then "8" else | ||
232 | if d10.rem == 9 then "9" else | ||
233 | abort null) | ||
234 | ); | ||
235 | |||
236 | __mn_quotRem = x: y: | ||
237 | let quot = x / y; in | ||
238 | { inherit quot; rem = x - quot * y; }; | ||
239 | __mn_abs = x: if x < 0 then -x else x; | ||
240 | |||
241 | __mn_attr_insertNew = as: x: e: | ||
242 | if x == null then { } else | ||
243 | assert !(as ? ${x}); as // __mn_singleton x e; | ||
244 | __mn_attr_has_aux = d: e: | ||
245 | if typeOf d != "set" then false else __mn_attr_has_prim d e; | ||
246 | __mn_attr_has = e: | ||
247 | __mn_matchList ({ head, tail, empty }: | ||
248 | if empty then true else | ||
249 | if __mn_attr_has_aux e head then __mn_attr_has e.${head} tail | ||
250 | else false); | ||
251 | __mn_attr_select = e: | ||
252 | __mn_matchList ({ head, tail, empty }: | ||
253 | if empty then e | ||
254 | else __mn_attr_select e.${head} tail); | ||
255 | __mn_attr_selectOr = e: as: d: | ||
256 | if __mn_attr_has e as | ||
257 | then __mn_attr_select e as | ||
258 | else d; | ||
259 | __mn_assert = e1: e2: | ||
260 | if e1 then e2 else abort null; | ||
261 | |||
262 | __mn_consAttrs = as: acc: | ||
263 | __mn_foldr | ||
264 | (x: acc: acc // { | ||
265 | ${x} = [ as.${x} ] ++ (acc.${x} or [ ]); | ||
266 | }) | ||
267 | acc | ||
268 | (attrNames as); | ||
269 | __mn_zipAttrs = __mn_foldr __mn_consAttrs { }; | ||
270 | |||
271 | # Old merge sort algorithm, taken from GHC.Internal.Data.OldList. | ||
272 | __mn_mergesort = cmp: xs: __mn_mergesort' cmp (__mn_singletons xs); | ||
273 | __mn_singletons = map (x: [ x ]); | ||
274 | __mn_mergesort' = cmp: xs: | ||
275 | __mn_matchList | ||
276 | ({ head, tail, empty }: | ||
277 | if empty then [ ] else if tail == [ ] then head else | ||
278 | __mn_mergesort' cmp (__mn_mergePairs cmp xs)) | ||
279 | xs; | ||
280 | __mn_mergePairs = cmp: | ||
281 | __mn_matchList ({ head, tail, empty }: if empty then [ ] else | ||
282 | let xs' = head; in __mn_matchList | ||
283 | ({ head, tail, empty }: | ||
284 | if empty then [ xs' ] else | ||
285 | let ys' = head; xss' = tail; in | ||
286 | [ (__mn_merge cmp xs' ys') ] ++ __mn_mergePairs cmp xss') | ||
287 | tail); | ||
288 | __mn_merge = cmp: xs: ys: | ||
289 | __mn_matchList | ||
290 | ({ head, tail, empty }: | ||
291 | if empty then ys else | ||
292 | let x = head; xs' = tail; in | ||
293 | __mn_matchList | ||
294 | ({ head, tail, empty }: | ||
295 | if empty then xs else | ||
296 | let y = head; ys' = tail; in | ||
297 | if cmp y x | ||
298 | then [ y ] ++ __mn_merge cmp xs ys' # y < x, i.e., x > y | ||
299 | else [ x ] ++ __mn_merge cmp xs' ys) | ||
300 | ys) | ||
301 | xs; | ||
302 | } | ||
diff --git a/lib/mininix/conv.ml b/lib/mininix/conv.ml new file mode 100644 index 0000000..8062099 --- /dev/null +++ b/lib/mininix/conv.ml | |||
@@ -0,0 +1,96 @@ | |||
1 | open Core | ||
2 | |||
3 | let _ = assert (Sys.word_size_in_bits = 64) | ||
4 | let chlist s = String.to_list s | ||
5 | let ( <> ) l1 l2 = not (List.equal Char.( = ) l1 l2) | ||
6 | let str = String.of_char_list | ||
7 | let prec = 53 | ||
8 | let emax = 1024 | ||
9 | let exp_bits = 11 | ||
10 | let saturated_exp = Int.shift_left 1 exp_bits - 1 | ||
11 | |||
12 | let rec int_bits (x : int) : bool list = | ||
13 | if Int.(x < 0) then raise (Invalid_argument "Number must be nonnegative") | ||
14 | else if Int.(x = 0) then [] | ||
15 | else | ||
16 | let q = x /% 2 and r = x % 2 in | ||
17 | int_bits q @ [ r = 1 ] | ||
18 | |||
19 | let int_to_positive (x : int) : Extraction.Internal.BinNums.positive = | ||
20 | if x <= 0 then raise (Invalid_argument "Number must be positive") | ||
21 | else | ||
22 | let bits = List.tl_exn (int_bits x) in | ||
23 | List.fold_left | ||
24 | ~f:(fun acc digit -> | ||
25 | if digit then Extraction.Internal.BinNums.Coq_xI acc | ||
26 | else Extraction.Internal.BinNums.Coq_xO acc) | ||
27 | ~init:Extraction.Internal.BinNums.Coq_xH bits | ||
28 | |||
29 | let int_to_z (x : int) : Extraction.Internal.BinNums.coq_Z = | ||
30 | if x = 0 then Z0 | ||
31 | else if x < 0 then Zneg (int_to_positive (-x)) | ||
32 | else Zpos (int_to_positive x) | ||
33 | |||
34 | let rec int63_of_positive (x : Extraction.Internal.BinNums.positive) : Int63.t = | ||
35 | let two = Int63.(succ one) in | ||
36 | match x with | ||
37 | | Coq_xH -> Int63.of_int_exn 1 | ||
38 | | Coq_xO x -> Int63.(two * int63_of_positive x) | ||
39 | | Coq_xI x -> Int63.((two * int63_of_positive x) + one) | ||
40 | |||
41 | let int63_of_z (x : Extraction.Internal.BinNums.coq_Z) : Int63.t = | ||
42 | match x with | ||
43 | | Z0 -> Int63.zero | ||
44 | | Zpos x -> int63_of_positive x | ||
45 | | Zneg x -> Int63.neg (int63_of_positive x) | ||
46 | |||
47 | let int63_to_positive x = Int63.to_int_exn x |> int_to_positive | ||
48 | |||
49 | (* Conversions are the same as those in Coq's FloatOps. | ||
50 | See https://github.com/coq/coq/blob/master/theories/Floats/FloatOps.v *) | ||
51 | |||
52 | let normfr_mantissa f = | ||
53 | let f = Float.abs f in | ||
54 | if Float.(f >= 0.5) && Float.(f < 1.) then Float.to_int (Float.ldexp f prec) | ||
55 | else 0 | ||
56 | |||
57 | let float_to_flocq (x : float) : Extraction.Internal.Floats.float = | ||
58 | match Float.classify x with | ||
59 | | Zero -> Extraction.Internal.Floats.B754_zero (Float.ieee_negative x) | ||
60 | | Nan -> | ||
61 | Extraction.Internal.Floats.B754_nan | ||
62 | (Float.ieee_negative x, Float.ieee_mantissa x |> int63_to_positive) | ||
63 | | Infinite -> Extraction.Internal.Floats.B754_infinity (Float.ieee_negative x) | ||
64 | | Normal | Subnormal -> ( | ||
65 | let prec_z = int_to_z prec and emax_z = int_to_z emax in | ||
66 | let r, exp = Float.frexp x in | ||
67 | let e = int_to_z (exp - prec) and r' = int_to_z (normfr_mantissa r) in | ||
68 | let shr, e' = | ||
69 | Extraction.Internal.Floats.(shr_fexp prec_z emax_z r' e Coq_loc_Exact) | ||
70 | in | ||
71 | match shr.shr_m with | ||
72 | | Zpos p -> B754_finite (Float.is_negative x, p, e') | ||
73 | | Zneg _ | Z0 -> assert false) | ||
74 | |||
75 | let float_from_flocq x : float = | ||
76 | match x with | ||
77 | | Extraction.Internal.Floats.B754_zero s -> | ||
78 | Float.create_ieee_exn ~negative:s ~mantissa:Int63.zero ~exponent:0 | ||
79 | | Extraction.Internal.Floats.B754_infinity s -> | ||
80 | if s then Float.neg_infinity else Float.infinity | ||
81 | | Extraction.Internal.Floats.B754_nan (s, m) -> | ||
82 | let m_int = int63_of_positive m in | ||
83 | Float.create_ieee_exn ~negative:s ~mantissa:m_int ~exponent:saturated_exp | ||
84 | | Extraction.Internal.Floats.B754_finite (s, m, e) -> | ||
85 | let pm = Float.of_int63 (int63_of_positive m) in | ||
86 | let f = Float.ldexp pm (Int63.to_int_exn (int63_of_z e)) in | ||
87 | if s then Float.neg f else f | ||
88 | |||
89 | open struct | ||
90 | open Base_quickcheck | ||
91 | |||
92 | let%expect_test "float conversion" = | ||
93 | Test.run_exn | ||
94 | (module Float) | ||
95 | ~f:(fun x -> [%test_eq: float] (float_from_flocq (float_to_flocq x)) x) | ||
96 | end | ||
diff --git a/lib/mininix/dune b/lib/mininix/dune new file mode 100644 index 0000000..aabbf45 --- /dev/null +++ b/lib/mininix/dune | |||
@@ -0,0 +1,15 @@ | |||
1 | (library | ||
2 | (name mininix) | ||
3 | (inline_tests) | ||
4 | (preprocessor_deps | ||
5 | (file builtins.nix)) | ||
6 | (preprocess | ||
7 | (pps | ||
8 | ppx_blob | ||
9 | ppx_sexp_conv | ||
10 | ppx_expect | ||
11 | ppx_assert | ||
12 | base_quickcheck.ppx_quickcheck)) | ||
13 | (instrumentation | ||
14 | (backend bisect_ppx)) | ||
15 | (libraries core extraction nix ppx_blob ppx_sexp_conv)) | ||
diff --git a/lib/mininix/import.ml b/lib/mininix/import.ml new file mode 100644 index 0000000..ca1bfb5 --- /dev/null +++ b/lib/mininix/import.ml | |||
@@ -0,0 +1,54 @@ | |||
1 | open Core | ||
2 | |||
3 | exception ImportError of string | ||
4 | |||
5 | type tree = { filename : string; deps : forest } | ||
6 | and forest = tree list | ||
7 | |||
8 | let provide (imports : (string * Extraction.coq_val) list) = | ||
9 | let imports_set = | ||
10 | Extraction.( | ||
11 | VAttr | ||
12 | (List.fold imports ~init:thunk_map_empty ~f:(fun attrs (filename, v) -> | ||
13 | thunk_map_insert (Conv.chlist filename) (Forced v) attrs))) | ||
14 | in | ||
15 | let make_env = | ||
16 | Extraction.( | ||
17 | env_insert_abs (Conv.chlist "imports") (Forced imports_set) env_empty) | ||
18 | in | ||
19 | Extraction.( | ||
20 | VClo | ||
21 | ( Conv.chlist "path", | ||
22 | make_env, | ||
23 | EBinOp | ||
24 | ( SelectAttrOp, | ||
25 | EId (Conv.chlist "imports", None), | ||
26 | EId (Conv.chlist "path", None) ) )) | ||
27 | |||
28 | let make_env (imports : (string * Extraction.coq_val) list) = | ||
29 | Extraction.( | ||
30 | env_insert_abs (Conv.chlist "import") (Forced (provide imports)) env_empty) | ||
31 | |||
32 | let rec import trees : (string * Extraction.coq_val) list = | ||
33 | List.map trees ~f:(fun { filename; deps } -> | ||
34 | let data = In_channel.read_all filename in | ||
35 | Nix.parse ~filename data |> Nix.elaborate |> Nix2mininix.from_nix | ||
36 | |> Builtins.apply_prelude | ||
37 | |> Run.interp ~fuel:`Unlimited ~mode:`Shallow | ||
38 | ~env:(make_env (import deps)) | ||
39 | |> function | ||
40 | | Res (Some v) -> (filename, v) | ||
41 | | Res None -> | ||
42 | raise | ||
43 | (ImportError | ||
44 | (sprintf "Could not import %s: Failed to evaluate" filename)) | ||
45 | | NoFuel -> assert false) | ||
46 | |||
47 | let rec tree_map ~(f : string -> string) { filename; deps } = | ||
48 | { filename = f filename; deps = forest_map ~f deps } | ||
49 | |||
50 | and forest_map ~(f : string -> string) trees = List.map ~f:(tree_map ~f) trees | ||
51 | |||
52 | (* [relative_to] must be an absolute path *) | ||
53 | let materialize forest ~relative_to : (string * Extraction.coq_val) list = | ||
54 | forest_map forest ~f:(Filename.to_absolute_exn ~relative_to) |> import | ||
diff --git a/lib/mininix/mininix.ml b/lib/mininix/mininix.ml new file mode 100644 index 0000000..b121619 --- /dev/null +++ b/lib/mininix/mininix.ml | |||
@@ -0,0 +1,13 @@ | |||
1 | module Nix2mininix = Nix2mininix | ||
2 | module Mininix2nix = Mininix2nix | ||
3 | module Sexp = Sexp | ||
4 | module Import = Import | ||
5 | |||
6 | let interp_tl ~fuel ~mode ?(imports = []) e = | ||
7 | Run.interp ~fuel ~mode ~env:(Import.make_env imports) e | ||
8 | |||
9 | let apply_prelude = Builtins.apply_prelude | ||
10 | |||
11 | let preprocess input ~filename = | ||
12 | input |> Nix.parse ~filename |> Nix.elaborate |> Nix2mininix.from_nix | ||
13 | |> Builtins.apply_prelude | ||
diff --git a/lib/mininix/mininix2nix.ml b/lib/mininix/mininix2nix.ml new file mode 100644 index 0000000..efbc42a --- /dev/null +++ b/lib/mininix/mininix2nix.ml | |||
@@ -0,0 +1,54 @@ | |||
1 | open Conv | ||
2 | open Core | ||
3 | |||
4 | (* [or] is not a 'strong' keyword. That means that 'it depends' whether it is | ||
5 | identified as such. In the context of the left-hand side of an attribute, it | ||
6 | is not recognized as such. *) | ||
7 | let strong_keywords = | ||
8 | [ "with"; "rec"; "let"; "in"; "inherit"; "if"; "then"; "else"; "assert" ] | ||
9 | |||
10 | let id_re = Str.regexp {|^[A-Za-z_]+[A-Za-z0-9'_-]*$|} | ||
11 | |||
12 | let is_simple_id s = | ||
13 | Str.string_match id_re s 0 | ||
14 | && not (List.exists strong_keywords ~f:(String.( = ) s)) | ||
15 | |||
16 | let thunk_map_to_map tm = | ||
17 | Extraction.thunk_map_fold | ||
18 | (fun k t -> Map.add_exn ~key:(String.of_char_list k) ~data:t) | ||
19 | (Map.empty (module String)) | ||
20 | tm | ||
21 | |||
22 | let from_lit l = | ||
23 | match l with | ||
24 | | Extraction.LitString s -> Nix.Ast.Val (Nix.Ast.Str (str s, [])) | ||
25 | | Extraction.LitNull -> Nix.Ast.Id "null" | ||
26 | | Extraction.LitBool b -> Nix.Ast.Id (if b then "true" else "false") | ||
27 | | Extraction.LitNum x -> | ||
28 | Nix.Ast.Val | ||
29 | (match x with | ||
30 | | Extraction.NInt x -> Nix.Ast.Int (x |> Extraction.string_of_Z |> str) | ||
31 | | Extraction.NFloat x -> | ||
32 | Nix.Ast.Float (Printf.sprintf "%g" (float_from_flocq x))) | ||
33 | |||
34 | let rec from_val = function | ||
35 | | Extraction.VClo _ | Extraction.VCloMatch _ -> Nix.Ast.Id "<CODE>" | ||
36 | | Extraction.VLit l -> from_lit l | ||
37 | | Extraction.VAttr bs -> | ||
38 | let bs = | ||
39 | thunk_map_to_map bs | ||
40 | |> Map.to_alist ~key_order:`Increasing | ||
41 | |> List.map ~f:(fun (x, t) -> | ||
42 | let lhs = | ||
43 | if is_simple_id x then Nix.Ast.Id x | ||
44 | else Nix.Ast.Val (Nix.Ast.Str (x, [])) | ||
45 | in | ||
46 | Nix.Ast.AttrPath ([ lhs ], from_thunk t)) | ||
47 | in | ||
48 | Nix.Ast.Val (Nix.Ast.AttSet (Nix.Ast.Nonrec, bs)) | ||
49 | | Extraction.VList ts -> Nix.Ast.Val (Nix.Ast.List List.(ts >>| from_thunk)) | ||
50 | |||
51 | and from_thunk = function | ||
52 | | Extraction.Thunk (_, ELit l) -> from_lit l | ||
53 | | Extraction.Thunk _ | Extraction.Indirect _ -> Nix.Ast.Id "<CODE>" | ||
54 | | Extraction.Forced v -> from_val v | ||
diff --git a/lib/mininix/nix2mininix.ml b/lib/mininix/nix2mininix.ml new file mode 100644 index 0000000..cfd4fa3 --- /dev/null +++ b/lib/mininix/nix2mininix.ml | |||
@@ -0,0 +1,254 @@ | |||
1 | open Conv | ||
2 | open Core | ||
3 | |||
4 | exception FromNixError of string | ||
5 | |||
6 | let try_insert_attr x e bs = | ||
7 | let x = chlist x in | ||
8 | if Extraction.attr_set_contains x bs then | ||
9 | raise (FromNixError "Attribute already exists") | ||
10 | else Extraction.attr_set_insert x e bs | ||
11 | |||
12 | (* Shorthands, minor conversions *) | ||
13 | |||
14 | let mn_singleton_set x e = | ||
15 | Extraction.( | ||
16 | EAttr (attr_set_insert (chlist x) (Attr (NONREC, e)) attr_set_empty)) | ||
17 | |||
18 | let mn_abs args e = | ||
19 | List.fold_right args ~init:e ~f:(fun arg e' -> | ||
20 | Extraction.EAbs (chlist arg, e')) | ||
21 | |||
22 | let mn_lit l = Extraction.ELit l | ||
23 | let mn_int x = mn_lit (Extraction.LitNum (Extraction.NInt x)) | ||
24 | let mn_float x = mn_lit (Extraction.LitNum (Extraction.NFloat x)) | ||
25 | let mn_bool b = mn_lit (Extraction.LitBool b) | ||
26 | let mn_true = mn_bool true | ||
27 | let mn_false = mn_bool false | ||
28 | let mn_str s = mn_lit (Extraction.LitString (chlist s)) | ||
29 | let mn_null = mn_lit Extraction.LitNull | ||
30 | let mn_id x = Extraction.EId (chlist x, None) | ||
31 | let mn_app e1 e2 = Extraction.EApp (e1, e2) | ||
32 | let mn_seq e1 e2 = Extraction.ESeq (Extraction.SHALLOW, e1, e2) | ||
33 | let mn_deep_seq e1 e2 = Extraction.ESeq (Extraction.DEEP, e1, e2) | ||
34 | let mn_list es = Extraction.EList es | ||
35 | |||
36 | let mn_attr (bs : (string * [ `Rec | `Nonrec ] * Extraction.expr) list) = | ||
37 | Extraction.EAttr | ||
38 | (List.fold_left bs ~init:Extraction.attr_set_empty ~f:(fun bs' (x, r, e) -> | ||
39 | let r' = | ||
40 | match r with `Rec -> Extraction.REC | `Nonrec -> Extraction.NONREC | ||
41 | in | ||
42 | Extraction.attr_set_insert (chlist x) (Extraction.Attr (r', e)) bs')) | ||
43 | |||
44 | let mn_with e1 e2 = Extraction.ELetAttr (Extraction.WITH, e1, e2) | ||
45 | let mn_binop op e1 e2 = Extraction.EBinOp (op, e1, e2) | ||
46 | let mn_add e1 e2 = mn_binop Extraction.AddOp e1 e2 | ||
47 | let mn_sub e1 e2 = mn_binop Extraction.SubOp e1 e2 | ||
48 | let mn_mul e1 e2 = mn_binop Extraction.MulOp e1 e2 | ||
49 | let mn_div e1 e2 = mn_binop Extraction.DivOp e1 e2 | ||
50 | let mn_bit_and e1 e2 = mn_binop Extraction.AndOp e1 e2 | ||
51 | let mn_bit_or e1 e2 = mn_binop Extraction.OrOp e1 e2 | ||
52 | let mn_bit_xor e1 e2 = mn_binop Extraction.XOrOp e1 e2 | ||
53 | let mn_lt e1 e2 = mn_binop Extraction.LtOp e1 e2 | ||
54 | let mn_eq e1 e2 = mn_binop Extraction.EqOp e1 e2 | ||
55 | let mn_if e1 e2 e3 = Extraction.EIf (e1, e2, e3) | ||
56 | let mn_delete_attr e1 e2 = mn_binop Extraction.DeleteAttrOp e1 e2 | ||
57 | let mn_has_attr e1 e2 = mn_binop Extraction.HasAttrOp e1 e2 | ||
58 | let mn_select_attr e1 e2 = mn_binop Extraction.SelectAttrOp e1 e2 | ||
59 | |||
60 | let mn_singleton_attr e1 e2 = | ||
61 | mn_app (mn_binop Extraction.SingletonAttrOp e1 mn_null) e2 | ||
62 | |||
63 | let mn_update_attr e1 e2 = mn_binop Extraction.UpdateAttrOp e1 e2 | ||
64 | let mn_type_of e = mn_binop Extraction.TypeOfOp e mn_null | ||
65 | let mn_function_args e = mn_binop Extraction.FunctionArgsOp e mn_null | ||
66 | let mn_list_append e1 e2 = mn_binop Extraction.AppendListOp e1 e2 | ||
67 | let mn_list_match e = mn_binop Extraction.MatchListOp e mn_null | ||
68 | let mn_string_match e = mn_binop Extraction.MatchStringOp e mn_null | ||
69 | let mn_attr_match e = mn_binop Extraction.MatchAttrOp e mn_null | ||
70 | let mn_ceil e = mn_binop (Extraction.RoundOp Ceil) e mn_null | ||
71 | let mn_nearest_even e = mn_binop (Extraction.RoundOp NearestEven) e mn_null | ||
72 | let mn_floor e = mn_binop (Extraction.RoundOp Floor) e mn_null | ||
73 | |||
74 | (* Macros *) | ||
75 | |||
76 | let mn_cast_bool e = mn_if e mn_true mn_false | ||
77 | let mn_or e1 e2 = mn_if e1 mn_true (mn_cast_bool e2) | ||
78 | let mn_and e1 e2 = mn_if e1 (mn_cast_bool e2) mn_false | ||
79 | let mn_impl e1 e2 = mn_if e1 (mn_cast_bool e2) mn_true | ||
80 | let mn_not e = mn_if e mn_false mn_true | ||
81 | let mn_negate e = mn_sub (mn_int Extraction.Internal.BinNums.Z0) e | ||
82 | let mn_neq e1 e2 = mn_not (mn_eq e2 e1) | ||
83 | let mn_gt e1 e2 = mn_lt e2 e1 | ||
84 | let mn_lte e1 e2 = mn_not (mn_gt e1 e2) | ||
85 | let mn_gte e1 e2 = mn_not (mn_lt e1 e2) | ||
86 | |||
87 | (* Macros based on exported functions from the prelude *) | ||
88 | |||
89 | let mnbi_assert e1 e2 = mn_app (mn_app (mn_id "__mn_assert") e1) e2 | ||
90 | let mnbi_has_attr e ds = mn_app (mn_app (mn_id "__mn_attr_has") e) (mn_list ds) | ||
91 | let mnbi_select e ds = mn_app (mn_app (mn_id "__mn_attr_select") e) (mn_list ds) | ||
92 | |||
93 | let mnbi_select_or e1 ds e2 = | ||
94 | mn_app (mn_app (mn_app (mn_id "__mn_attr_selectOr") e1) (mn_list ds)) e2 | ||
95 | |||
96 | let mnbi_insert_new e1 e2 e3 = | ||
97 | mn_app (mn_app (mn_app (mn_id "__mn_attr_insertNew") e1) e2) e3 | ||
98 | |||
99 | let is_dynamic_binding (b : Nix.Ast.binding) = | ||
100 | match b with | ||
101 | | Nix.Ast.AttrPath ([ Nix.Ast.Val (Nix.Ast.Str (_, [])) ], _) | ||
102 | | Nix.Ast.Inherit _ -> | ||
103 | false | ||
104 | | Nix.Ast.AttrPath ([ _ ], _) -> true | ||
105 | | _ -> assert false | ||
106 | |||
107 | let has_dynamic_bindings (bs : Nix.Ast.binding list) = | ||
108 | List.exists bs ~f:is_dynamic_binding | ||
109 | |||
110 | (* Static bindings left, dynamic bindings right *) | ||
111 | let partition_dynamic (bs : Nix.Ast.binding list) : | ||
112 | Nix.Ast.binding list * Nix.Ast.binding list = | ||
113 | List.fold_left bs ~init:([], []) ~f:(fun (static, dynamic) b -> | ||
114 | if is_dynamic_binding b then (static, b :: dynamic) | ||
115 | else (b :: static, dynamic)) | ||
116 | |||
117 | (* Precondition: e must be have been processed by the elaborator. *) | ||
118 | let rec from_nix e = | ||
119 | match e with | ||
120 | | Nix.Ast.BinaryOp (op, e1, e2) -> ( | ||
121 | let e1', e2' = (from_nix e1, from_nix e2) in | ||
122 | match op with | ||
123 | | Nix.Ast.Plus -> mn_add e1' e2' | ||
124 | | Nix.Ast.Minus -> mn_sub e1' e2' | ||
125 | | Nix.Ast.Mult -> mn_mul e1' e2' | ||
126 | | Nix.Ast.Div -> mn_div e1' e2' | ||
127 | | Nix.Ast.Gt -> mn_gt e1' e2' | ||
128 | | Nix.Ast.Lt -> mn_lt e1' e2' | ||
129 | | Nix.Ast.Lte -> mn_lte e1' e2' | ||
130 | | Nix.Ast.Gte -> mn_gte e1' e2' | ||
131 | | Nix.Ast.Eq -> mn_eq e1' e2' | ||
132 | | Nix.Ast.Neq -> mn_neq e1' e2' | ||
133 | | Nix.Ast.Or -> mn_or e1' e2' | ||
134 | | Nix.Ast.And -> mn_and e1' e2' | ||
135 | | Nix.Ast.Impl -> mn_impl e1' e2' | ||
136 | | Nix.Ast.Merge -> mn_update_attr e1' e2' | ||
137 | | Nix.Ast.Concat -> mn_list_append e1' e2') | ||
138 | | Nix.Ast.UnaryOp (op, e) -> ( | ||
139 | let e = from_nix e in | ||
140 | match op with Nix.Ast.Negate -> mn_negate e | Nix.Ast.Not -> mn_not e) | ||
141 | | Nix.Ast.Cond (e1, e2, e3) -> mn_if (from_nix e1) (from_nix e2) (from_nix e3) | ||
142 | | Nix.Ast.With (e1, e2) -> mn_with (from_nix e1) (from_nix e2) | ||
143 | | Nix.Ast.Assert (e1, e2) -> mnbi_assert (from_nix e1) (from_nix e2) | ||
144 | | Nix.Ast.Test (e, ds) -> mnbi_has_attr (from_nix e) List.(ds >>| from_nix) | ||
145 | | Nix.Ast.SetLet bs -> | ||
146 | from_nix | ||
147 | (Nix.Ast.Select | ||
148 | ( Nix.Ast.Val (Nix.Ast.AttSet (Nix.Ast.Rec, bs)), | ||
149 | [ Nix.Ast.Val (Nix.Ast.Str ("body", [])) ], | ||
150 | None )) | ||
151 | | Nix.Ast.Let (bs, e2) -> | ||
152 | if has_dynamic_bindings bs then | ||
153 | raise (FromNixError "Let bindings may not be dynamic"); | ||
154 | let e1 = from_nix (Nix.Ast.Val (Nix.Ast.AttSet (Nix.Ast.Rec, bs))) in | ||
155 | Extraction.ELetAttr (Extraction.ABS, e1, from_nix e2) | ||
156 | | Nix.Ast.Val v -> from_nix_val v | ||
157 | | Nix.Ast.Id x -> mn_id x | ||
158 | | Nix.Ast.Select (e, parts, md) -> ( | ||
159 | match md with | ||
160 | | Some d -> | ||
161 | mnbi_select_or (from_nix e) List.(parts >>| from_nix) (from_nix d) | ||
162 | | None -> ( | ||
163 | match parts with | ||
164 | | [ part ] -> mn_select_attr (from_nix e) (from_nix part) | ||
165 | | _ -> mnbi_select (from_nix e) List.(parts >>| from_nix))) | ||
166 | | Nix.Ast.Apply (e1, e2) -> mn_app (from_nix e1) (from_nix e2) | ||
167 | | Nix.Ast.Aquote _ -> | ||
168 | assert false (* should be gone after processing by elaborator *) | ||
169 | |||
170 | and from_nix_val v = | ||
171 | match v with | ||
172 | | Str (s, parts) -> | ||
173 | let parts = List.(parts >>= fun (e, s) -> [ from_nix e; mn_str s ]) in | ||
174 | List.fold_left parts ~init:(mn_str s) ~f:mn_add | ||
175 | | IStr _ -> raise (FromNixError "Indented strings are not supported") | ||
176 | | Int n -> ( | ||
177 | match Extraction.string_to_Z (chlist n) with | ||
178 | | Some n -> mn_int n | ||
179 | | None -> raise (FromNixError "Bad integer literal")) | ||
180 | | Float n -> | ||
181 | let n = | ||
182 | try Float.of_string n | ||
183 | with Invalid_argument _ -> raise (FromNixError "Bad float literal") | ||
184 | in | ||
185 | if Float.(is_nan n || is_inf n) then | ||
186 | raise (FromNixError "Bad float literal") | ||
187 | else mn_float (float_to_flocq n) | ||
188 | | Path _ | SPath _ | HPath _ -> raise (FromNixError "Paths are not supported") | ||
189 | | Uri s -> mn_str s | ||
190 | | Lambda (Alias x, e) -> mn_abs [ x ] (from_nix e) | ||
191 | | Lambda (ParamSet (Some x, fs), e) -> | ||
192 | from_nix_val | ||
193 | (Lambda (Alias x, Apply (Val (Lambda (ParamSet (None, fs), e)), Id x))) | ||
194 | | Lambda (ParamSet (None, (fs, strictness)), e) -> | ||
195 | let ms = | ||
196 | List.fold_left fs ~init:Extraction.matcher_empty ~f:(fun ms (x, me) -> | ||
197 | Extraction.matcher_insert (chlist x) (Option.map ~f:from_nix me) ms) | ||
198 | in | ||
199 | Extraction.EAbsMatch | ||
200 | ( ms, | ||
201 | (match strictness with Loose -> false | Exact -> true), | ||
202 | from_nix e ) | ||
203 | | List es -> mn_list (List.map es ~f:from_nix) | ||
204 | | AttSet (recursivity, bs) -> | ||
205 | let static, dynamic = partition_dynamic bs | ||
206 | and recursivity' = | ||
207 | match recursivity with | ||
208 | | Nix.Ast.Rec -> Extraction.REC | ||
209 | | Nix.Ast.Nonrec -> Extraction.NONREC | ||
210 | in | ||
211 | |||
212 | let set_no_dyn = | ||
213 | Extraction.EAttr | ||
214 | (List.fold_left static ~init:Extraction.attr_set_empty | ||
215 | ~f:(fun static' bnd -> | ||
216 | match bnd with | ||
217 | | Nix.Ast.AttrPath ([ Nix.Ast.Val (Nix.Ast.Str (x, [])) ], e) -> | ||
218 | try_insert_attr x | ||
219 | (Extraction.Attr (recursivity', from_nix e)) | ||
220 | static' | ||
221 | | Nix.Ast.Inherit (None, xs) -> | ||
222 | List.fold_left xs ~init:static' ~f:(fun static' x -> | ||
223 | match x with | ||
224 | | Id x -> | ||
225 | try_insert_attr x | ||
226 | (Extraction.Attr (Extraction.NONREC, mn_id x)) | ||
227 | static' | ||
228 | | _ -> assert false) | ||
229 | | Nix.Ast.Inherit (Some e, xs) -> | ||
230 | let e = from_nix e in | ||
231 | List.fold_left xs ~init:static' ~f:(fun static' x -> | ||
232 | match x with | ||
233 | | Id x -> | ||
234 | try_insert_attr x | ||
235 | (Extraction.Attr | ||
236 | (recursivity', mn_select_attr e (mn_str x))) | ||
237 | static' | ||
238 | | _ -> assert false) | ||
239 | | _ -> assert false)) | ||
240 | in | ||
241 | |||
242 | List.fold_right dynamic ~init:set_no_dyn ~f:(fun bnd set -> | ||
243 | match bnd with | ||
244 | | Nix.Ast.AttrPath ([ d ], e) -> | ||
245 | mnbi_insert_new set | ||
246 | (match recursivity with | ||
247 | | Nix.Ast.Rec -> | ||
248 | Extraction.ELetAttr (Extraction.ABS, set_no_dyn, from_nix d) | ||
249 | | Nix.Ast.Nonrec -> from_nix d) | ||
250 | (match recursivity with | ||
251 | | Nix.Ast.Rec -> | ||
252 | Extraction.ELetAttr (Extraction.ABS, set_no_dyn, from_nix e) | ||
253 | | Nix.Ast.Nonrec -> from_nix e) | ||
254 | | _ -> assert false) | ||
diff --git a/lib/mininix/run.ml b/lib/mininix/run.ml new file mode 100644 index 0000000..f33bace --- /dev/null +++ b/lib/mininix/run.ml | |||
@@ -0,0 +1,17 @@ | |||
1 | open Core | ||
2 | |||
3 | (* The [n]th Church numeral *) | ||
4 | let rec church n f x = if n <= 0 then x else church (n - 1) f (f x) | ||
5 | |||
6 | let limited = | ||
7 | church 2048 | ||
8 | (fun x -> Extraction.Internal.Datatypes.S x) | ||
9 | Extraction.Internal.Datatypes.O | ||
10 | |||
11 | let rec infinity = Extraction.Internal.Datatypes.S infinity | ||
12 | |||
13 | let interp ~fuel ~mode ~env e = | ||
14 | let mode : Extraction.mode = | ||
15 | match mode with `Shallow -> SHALLOW | `Deep -> DEEP | ||
16 | and fuel = match fuel with `Unlimited -> infinity | `Limited -> limited in | ||
17 | Extraction.interp' fuel mode env e | ||
diff --git a/lib/mininix/sexp.ml b/lib/mininix/sexp.ml new file mode 100644 index 0000000..95da655 --- /dev/null +++ b/lib/mininix/sexp.ml | |||
@@ -0,0 +1,160 @@ | |||
1 | open Conv | ||
2 | open Core | ||
3 | open Extraction | ||
4 | |||
5 | exception ToSexpError of string | ||
6 | |||
7 | let tag t l = Sexp.List (Sexp.Atom t :: l) | ||
8 | |||
9 | let lit_to_sexp = function | ||
10 | | LitString s -> tag "LitString" [ Sexp.Atom (str s) ] | ||
11 | | LitNum (NInt n) -> | ||
12 | tag "LitNum" [ Sexp.Atom "INT"; Sexp.Atom (str (string_of_Z n)) ] | ||
13 | | LitNum (NFloat n) -> | ||
14 | tag "LitNum" | ||
15 | [ | ||
16 | Sexp.Atom "FLOAT"; | ||
17 | Sexp.Atom (Printf.sprintf "%g" (float_from_flocq n)); | ||
18 | ] | ||
19 | | LitBool b -> tag "LitBool" [ Sexp.Atom (Bool.to_string b) ] | ||
20 | | LitNull -> tag "LitNull" [] | ||
21 | |||
22 | let option_to_sexp mv ~f = | ||
23 | match mv with Some v -> tag "Some" [ f v ] | None -> Sexp.Atom "None" | ||
24 | |||
25 | let mode_to_sexp mode = | ||
26 | Sexp.Atom (match mode with SHALLOW -> "SHALLOW" | DEEP -> "DEEP") | ||
27 | |||
28 | let rec_to_sexp r = Sexp.Atom (match r with REC -> "REC" | NONREC -> "NONREC") | ||
29 | |||
30 | let binop_to_sexp op = | ||
31 | Sexp.Atom | ||
32 | (match op with | ||
33 | | UpdateAttrOp -> "UpdateAttrOp" | ||
34 | | AddOp -> "AddOp" | ||
35 | | SubOp -> "SubOp" | ||
36 | | MulOp -> "MulOp" | ||
37 | | DivOp -> "DivOp" | ||
38 | | AndOp -> "AndOp" | ||
39 | | OrOp -> "OrOp" | ||
40 | | XOrOp -> "XOrOp" | ||
41 | | RoundOp Ceil -> "Ceil" | ||
42 | | RoundOp NearestEven -> "NearestEven" | ||
43 | | RoundOp Floor -> "Floor" | ||
44 | | LtOp -> "LtOp" | ||
45 | | EqOp -> "EqOp" | ||
46 | | HasAttrOp -> "HasAttrOp" | ||
47 | | SelectAttrOp -> "SelectAttrOp" | ||
48 | | DeleteAttrOp -> "DeleteAttrOp" | ||
49 | | SingletonAttrOp -> "SingletonAttrOp" | ||
50 | | TypeOfOp -> "TypeOfOp" | ||
51 | | AppendListOp -> "AppendListOp" | ||
52 | | MatchAttrOp -> "MatchAttrOp" | ||
53 | | MatchListOp -> "MatchListOp" | ||
54 | | MatchStringOp -> "MatchStringOp" | ||
55 | | FunctionArgsOp -> "FunctionArgsOp") | ||
56 | |||
57 | let kind_to_sexp k = Sexp.Atom (match k with ABS -> "ABS" | WITH -> "WITH") | ||
58 | |||
59 | let rec expr_to_sexp = function | ||
60 | | ELit l -> tag "ELit" [ lit_to_sexp l ] | ||
61 | | EId (x, None) -> tag "EId" [ Sexp.Atom (str x) ] | ||
62 | | EId (x, Some (k, e)) -> | ||
63 | tag "EId" | ||
64 | [ Sexp.Atom (str x); tag "alt" [ kind_to_sexp k; expr_to_sexp e ] ] | ||
65 | | EAbs (x, e) -> tag "EAbs" [ Sexp.Atom (str x); expr_to_sexp e ] | ||
66 | | EAbsMatch (ms, strict, e) -> | ||
67 | tag "EAbsMatch" | ||
68 | [ | ||
69 | Sexp.Atom (if strict then "EXACT" else "LOOSE"); | ||
70 | tag "formals" | ||
71 | (matcher_fold | ||
72 | (fun x me se -> | ||
73 | Sexp.List | ||
74 | [ Sexp.Atom (str x); option_to_sexp me ~f:expr_to_sexp ] | ||
75 | :: se) | ||
76 | [] ms); | ||
77 | expr_to_sexp e; | ||
78 | ] | ||
79 | | EApp (e1, e2) -> tag "EApp" [ expr_to_sexp e1; expr_to_sexp e2 ] | ||
80 | | ELetAttr (k, e1, e2) -> | ||
81 | tag "ELetAttr" [ kind_to_sexp k; expr_to_sexp e1; expr_to_sexp e2 ] | ||
82 | | ESeq (mode, e1, e2) -> | ||
83 | tag "ESeq" [ mode_to_sexp mode; expr_to_sexp e1; expr_to_sexp e2 ] | ||
84 | | EAttr bs -> | ||
85 | tag "EAttr" | ||
86 | (attr_set_fold | ||
87 | (fun x (Attr (r, e)) se -> | ||
88 | Sexp.List [ Sexp.Atom (str x); rec_to_sexp r; expr_to_sexp e ] | ||
89 | :: se) | ||
90 | [] bs) | ||
91 | | EList es -> | ||
92 | tag "EList" | ||
93 | (Internal.List.fold_right (fun e se -> expr_to_sexp e :: se) [] es) | ||
94 | | EBinOp (op, e1, e2) -> | ||
95 | tag "EBinOp" [ binop_to_sexp op; expr_to_sexp e1; expr_to_sexp e2 ] | ||
96 | | EIf (e1, e2, e3) -> | ||
97 | tag "EIf" [ expr_to_sexp e1; expr_to_sexp e2; expr_to_sexp e3 ] | ||
98 | |||
99 | let rec val_to_sexp = function | ||
100 | | VLit l -> tag "VLit" [ lit_to_sexp l ] | ||
101 | | VClo _ -> tag "VClo" [] | ||
102 | | VCloMatch _ -> tag "VCloMatch" [] | ||
103 | | VAttr bs -> | ||
104 | tag "VAttr" | ||
105 | (Extraction.thunk_map_fold | ||
106 | (fun x t bs' -> | ||
107 | Sexp.List [ Sexp.Atom (str x); thunk_to_sexp t ] :: bs') | ||
108 | [] bs) | ||
109 | | VList ts -> | ||
110 | tag "VList" | ||
111 | (Internal.List.fold_right (fun t st -> thunk_to_sexp t :: st) [] ts) | ||
112 | |||
113 | and env_to_sexp env = | ||
114 | tag "Env" | ||
115 | (Extraction.env_fold | ||
116 | (fun x (k, t) envs -> | ||
117 | Sexp.List | ||
118 | [ | ||
119 | Sexp.Atom (str x); | ||
120 | Sexp.Atom | ||
121 | (match k with | ||
122 | | Extraction.ABS -> "ABS" | ||
123 | | Extraction.WITH -> "WITH"); | ||
124 | thunk_to_sexp t; | ||
125 | ] | ||
126 | :: envs) | ||
127 | [] env) | ||
128 | |||
129 | and thunk_to_sexp = function | ||
130 | | Thunk _ -> tag "Thunk" [ Sexp.Atom "DELAYED" ] | ||
131 | | Indirect _ -> tag "Thunk" [ Sexp.Atom "INDIRECT" ] | ||
132 | | Forced v -> tag "Thunk" [ Sexp.Atom "FORCED"; val_to_sexp v ] | ||
133 | |||
134 | let expr_res_to_sexp = function | ||
135 | | NoFuel -> Sexp.Atom "NoFuel" | ||
136 | | Res e -> tag "Res" [ option_to_sexp e ~f:expr_to_sexp ] | ||
137 | |||
138 | let val_res_to_sexp = function | ||
139 | | NoFuel -> Sexp.Atom "NoFuel" | ||
140 | | Res e -> tag "Res" [ option_to_sexp e ~f:val_to_sexp ] | ||
141 | |||
142 | let rec (sexp_of_import_tree : Import.tree -> Sexp.t) = function | ||
143 | | { filename; deps = [] } -> Sexp.Atom filename | ||
144 | | { filename; deps } -> | ||
145 | Sexp.List [ Sexp.Atom filename; sexp_of_import_forest deps ] | ||
146 | |||
147 | and sexp_of_import_forest forest = | ||
148 | Sexp.List (Sexp.Atom "deps" :: List.map forest ~f:sexp_of_import_tree) | ||
149 | |||
150 | exception OfSexpError of string | ||
151 | |||
152 | let rec import_tree_of_sexp : Sexp.t -> Import.tree = function | ||
153 | | Sexp.Atom filename -> { filename; deps = [] } | ||
154 | | Sexp.List [ Sexp.Atom filename; deps ] -> | ||
155 | { filename; deps = import_forest_of_sexp deps } | ||
156 | | _ -> raise (OfSexpError "Could not parse import tree") | ||
157 | |||
158 | and import_forest_of_sexp = function | ||
159 | | Sexp.List (Sexp.Atom "deps" :: deps) -> List.map ~f:import_tree_of_sexp deps | ||
160 | | _ -> raise (OfSexpError "Could not parse import forest") | ||
diff --git a/lib/nix/dune b/lib/nix/dune new file mode 100644 index 0000000..3954c8a --- /dev/null +++ b/lib/nix/dune | |||
@@ -0,0 +1,15 @@ | |||
1 | (menhir | ||
2 | (modules parser) | ||
3 | (flags "--dump" "--strict" "--external-tokens" "Tokens") | ||
4 | (infer true)) | ||
5 | |||
6 | (ocamllex | ||
7 | (modules lexer)) | ||
8 | |||
9 | (library | ||
10 | (name nix) | ||
11 | (preprocess | ||
12 | (pps ppx_sexp_conv)) | ||
13 | (instrumentation | ||
14 | (backend bisect_ppx)) | ||
15 | (libraries core core_unix core_unix.filename_unix pprint ppx_sexp_conv str)) | ||
diff --git a/lib/nix/elaborator.ml b/lib/nix/elaborator.ml new file mode 100644 index 0000000..36ee0d4 --- /dev/null +++ b/lib/nix/elaborator.ml | |||
@@ -0,0 +1,208 @@ | |||
1 | open Core | ||
2 | open Types | ||
3 | |||
4 | (* The Nix elaborator does a few things: | ||
5 | - Attribute paths are transformed into a simple list of expressions: | ||
6 | + Simple identifiers are rewritten to string values | ||
7 | + Antiquotations are rewritten to their component expressions | ||
8 | + Anything else, that is not a string value, is rejected | ||
9 | and raises an exception | ||
10 | - In 'inherit (...) x1 ... xn', x1 ... xn are checked for 'reasonably' being | ||
11 | identifiers, i.e., being one of x, "x" and ${"x"}. | ||
12 | - Nested attribute paths are unfolded and attribute sets are merged where | ||
13 | possible. (Where we mean 'what Nix does' with 'where possible'; see the | ||
14 | comment at the respective function.) | ||
15 | - Paths are turned into strings and made absolute w.r.t. the current | ||
16 | working directory. | ||
17 | - Indented strings are converted to their 'normal' counterpart. *) | ||
18 | |||
19 | exception ElaborateError of string | ||
20 | |||
21 | type attr_set = recursivity * binding list | ||
22 | |||
23 | let set_expr (r, bs) = Val (AttSet (r, bs)) | ||
24 | let get_id = function Id x -> x | _ -> assert false | ||
25 | |||
26 | let rec update_bnd (bs : binding list) (x : string) ~(f : expr option -> expr) = | ||
27 | match bs with | ||
28 | | [] -> [ AttrPath ([ Val (Str (x, [])) ], f None) ] | ||
29 | | AttrPath ([ Val (Str (y, [])) ], e) :: s' when String.(x = y) -> | ||
30 | AttrPath ([ Val (Str (y, [])) ], f (Some e)) :: s' | ||
31 | | Inherit (_, ids) :: _ | ||
32 | when List.exists ids ~f:(fun e -> String.(get_id e = x)) -> | ||
33 | raise (ElaborateError "Cannot update inherit") | ||
34 | | bnd :: s' -> bnd :: update_bnd s' x ~f | ||
35 | |||
36 | let set_update_bnd (r, bs) x ~f = (r, update_bnd bs x ~f) | ||
37 | |||
38 | let rec has_bnd (bs : binding list) (x : string) : bool = | ||
39 | match bs with | ||
40 | | [] -> false | ||
41 | | AttrPath ([ Val (Str (y, [])) ], _) :: _ when String.(x = y) -> true | ||
42 | | Inherit (_, ids) :: _ | ||
43 | when List.exists ids ~f:(fun e -> String.(get_id e = x)) -> | ||
44 | true | ||
45 | | _ :: bs' -> has_bnd bs' x | ||
46 | |||
47 | let merge_bnds bs1 bs2 : binding list = | ||
48 | List.fold_left bs2 ~init:bs1 ~f:(fun bs1' b2 -> | ||
49 | match b2 with | ||
50 | | AttrPath ([ Val (Str (x, [])) ], e) -> | ||
51 | update_bnd bs1' x ~f:(function | ||
52 | | Some _ -> raise (ElaborateError "Duplicated attribute") | ||
53 | | None -> e) | ||
54 | | AttrPath ([ d ], e) -> AttrPath ([ d ], e) :: bs1' | ||
55 | | Inherit (md, xs) -> | ||
56 | if List.for_all xs ~f:(fun e -> not (has_bnd bs1' (get_id e))) then | ||
57 | Inherit (md, xs) :: bs1' | ||
58 | else raise (ElaborateError "Duplicated attribute") | ||
59 | | _ -> assert false) | ||
60 | |||
61 | (* This function intentionally clobbers recursivity, because that is the way | ||
62 | that Nix likes to handle attribute insertion. See | ||
63 | (1) https://github.com/NixOS/nix/issues/9020 | ||
64 | (2) https://github.com/NixOS/nix/issues/11268 | ||
65 | (3) https://github.com/NixOS/nix/pull/11294 *) | ||
66 | let rec insert (bs : binding list) (path : expr list) (e : expr) = | ||
67 | match path with | ||
68 | | [] -> raise (ElaborateError "Cannot insert attribute with empty path") | ||
69 | | [ Val (Str (x, [])) ] -> | ||
70 | update_bnd bs x ~f:(function | ||
71 | | None -> e | ||
72 | | Some (Val (AttSet (r1, bs1))) -> ( | ||
73 | match e with | ||
74 | | Val (AttSet (_, bs2)) -> set_expr (r1, merge_bnds bs1 bs2) | ||
75 | | _ -> raise (ElaborateError "Duplicated attribute")) | ||
76 | | _ -> raise (ElaborateError "Duplicated attribute")) | ||
77 | | Val (Str (x, [])) :: rest -> | ||
78 | update_bnd bs x ~f:(function | ||
79 | | Some (Val (AttSet (r, bs))) -> Val (AttSet (r, insert bs rest e)) | ||
80 | | Some _ -> raise (ElaborateError "Duplicated attribute") | ||
81 | | None -> Val (AttSet (Nonrec, insert [] rest e))) | ||
82 | | [ part ] -> AttrPath ([ part ], e) :: bs | ||
83 | | part :: rest -> | ||
84 | AttrPath ([ part ], Val (AttSet (Nonrec, insert [] rest e))) :: bs | ||
85 | |||
86 | let insert_inherit (bs : binding list) (from : expr option) (es : expr list) = | ||
87 | if List.for_all es ~f:(fun e -> not (has_bnd bs (get_id e))) then | ||
88 | Inherit (from, es) :: bs | ||
89 | else raise (ElaborateError "Duplicated attribute") | ||
90 | |||
91 | let simplify_path_component = function | ||
92 | | Id x -> Val (Str (x, [])) | ||
93 | | Val (Str (s, ess)) -> Val (Str (s, ess)) | ||
94 | | Aquote e -> e | ||
95 | | _ -> raise (ElaborateError "Unexpected path component") | ||
96 | |||
97 | let simplify_path = List.map ~f:simplify_path_component | ||
98 | |||
99 | let simplify_bnd_paths = | ||
100 | List.map ~f:(fun bnd -> | ||
101 | match bnd with | ||
102 | | AttrPath (path, e) -> AttrPath (simplify_path path, e) | ||
103 | | Inherit (me, xs) -> Inherit (me, xs)) | ||
104 | |||
105 | (* Law: concat_lines ∘ split_lines = id *) | ||
106 | |||
107 | let rec split_lines s = | ||
108 | match String.lsplit2 s ~on:'\n' with | ||
109 | | Some (s1, s2) -> s1 :: split_lines s2 | ||
110 | | None -> [ s ] | ||
111 | |||
112 | let rec concat_lines = function | ||
113 | | [] -> "" | ||
114 | | [ x ] -> x | ||
115 | | x :: xs -> x ^ "\n" ^ concat_lines xs | ||
116 | |||
117 | let map_tail ~f = function [] -> [] | x :: xs -> x :: List.map ~f xs | ||
118 | |||
119 | let unindent n s ~skip_first_line = | ||
120 | let map_op ~f = if skip_first_line then map_tail ~f else List.map ~f in | ||
121 | split_lines s | ||
122 | |> map_op ~f:(fun line -> | ||
123 | let expected_prefix = String.make n ' ' in | ||
124 | String.chop_prefix_if_exists ~prefix:expected_prefix line) | ||
125 | |> concat_lines | ||
126 | |||
127 | let is_spaces l = String.(strip l ~drop:(Char.( = ) ' ') |> is_empty) | ||
128 | |||
129 | let drop_first_empty_line s = | ||
130 | match String.lsplit2 s ~on:'\n' with | ||
131 | | Some (l, s') when is_spaces l -> s' | ||
132 | | _ -> s | ||
133 | |||
134 | let rec process ?(dir = None) = function | ||
135 | | BinaryOp (op, e1, e2) -> BinaryOp (op, process ~dir e1, process ~dir e2) | ||
136 | | UnaryOp (op, e) -> UnaryOp (op, process ~dir e) | ||
137 | | Cond (e1, e2, e3) -> Cond (process ~dir e1, process ~dir e2, process ~dir e3) | ||
138 | | With (e1, e2) -> With (process ~dir e1, process ~dir e2) | ||
139 | | Assert (e1, e2) -> Assert (process ~dir e1, process ~dir e2) | ||
140 | | Test (e1, es) -> | ||
141 | Test (process ~dir e1, List.(simplify_path es >>| process ~dir)) | ||
142 | | SetLet bs -> SetLet (process_bnds ~dir bs) | ||
143 | | Let (bs, e) -> Let (process_bnds ~dir bs, process ~dir e) | ||
144 | | Val v -> Val (process_val ~dir v) | ||
145 | | Id x -> Id x | ||
146 | | Select (e, es, me) -> | ||
147 | Select | ||
148 | ( process ~dir e, | ||
149 | List.(simplify_path es >>| process ~dir), | ||
150 | Option.(me >>| process ~dir) ) | ||
151 | | Apply (e1, e2) -> Apply (process ~dir e1, process ~dir e2) | ||
152 | | Aquote e -> Aquote (process ~dir e) | ||
153 | |||
154 | and process_val ~dir = function | ||
155 | | Str (s, ess) -> Str (s, List.(ess >>| fun (e, s) -> (process ~dir e, s))) | ||
156 | | IStr (n, s, ess) -> | ||
157 | let s' = drop_first_empty_line (unindent n s ~skip_first_line:false) | ||
158 | and ess' = | ||
159 | List.map ess ~f:(fun (e, s) -> | ||
160 | (process ~dir e, unindent n s ~skip_first_line:true)) | ||
161 | in | ||
162 | Str (s', ess') | ||
163 | | Lambda (p, e) -> Lambda (process_pattern ~dir p, process ~dir e) | ||
164 | | List es -> List List.(es >>| process ~dir) | ||
165 | | AttSet (r, bs) -> AttSet (r, process_bnds ~dir bs) | ||
166 | | Path p -> ( | ||
167 | if Filename.is_absolute p then Str (p, []) | ||
168 | else | ||
169 | match dir with | ||
170 | | Some dir when Filename.is_absolute dir -> | ||
171 | Str (Filename.concat dir p, []) | ||
172 | | Some _ -> | ||
173 | raise | ||
174 | (ElaborateError "Provided directory should be an absolute path") | ||
175 | | None -> raise (ElaborateError "Do not know how to resolve path")) | ||
176 | | v -> v | ||
177 | |||
178 | and process_bnds ~dir bs = | ||
179 | bs | ||
180 | |> List.map ~f:(function | ||
181 | | AttrPath (es, e) -> | ||
182 | AttrPath (List.(es >>| process ~dir), process ~dir e) | ||
183 | | Inherit (me, xs) -> | ||
184 | Inherit (Option.(me >>| process ~dir), process_inherit_ids xs)) | ||
185 | |> simplify_bnd_paths | ||
186 | |> List.fold ~init:[] ~f:(fun bs' bnd -> | ||
187 | match bnd with | ||
188 | | AttrPath (path, e) -> insert bs' path e | ||
189 | | Inherit (from, es) -> insert_inherit bs' from es) | ||
190 | |||
191 | and process_inherit_ids = | ||
192 | List.map ~f:(function | ||
193 | | Id x | Val (Str (x, [])) | Aquote (Val (Str (x, []))) -> Id x | ||
194 | | _ -> raise (ElaborateError "Unexpected expression in inherit")) | ||
195 | |||
196 | and process_pattern ~dir = function | ||
197 | | Alias x -> Alias x | ||
198 | | ParamSet (mx, (ps, k)) -> ParamSet (mx, (process_param_set ~dir mx ps, k)) | ||
199 | |||
200 | and process_param_set ~dir ?(seen = String.Set.empty) mx ps = | ||
201 | match ps with | ||
202 | | [] -> [] | ||
203 | | (y, me) :: ps' -> | ||
204 | if Set.mem seen y || Option.mem mx y ~equal:String.( = ) then | ||
205 | raise (ElaborateError "Duplicated function argument") | ||
206 | else | ||
207 | (y, Option.(me >>| process ~dir)) | ||
208 | :: process_param_set ~dir mx ps' ~seen:(Set.add seen y) | ||
diff --git a/lib/nix/lexer.mll b/lib/nix/lexer.mll new file mode 100644 index 0000000..023d888 --- /dev/null +++ b/lib/nix/lexer.mll | |||
@@ -0,0 +1,315 @@ | |||
1 | { | ||
2 | open Core | ||
3 | open Tokens | ||
4 | |||
5 | exception Error of string | ||
6 | |||
7 | (* Types of curly braces. | ||
8 | AQUOTE corresponds to the braces for antiquotation, i.e. '${...}' | ||
9 | and SET to an attribute set '{...}'. | ||
10 | *) | ||
11 | type braces = | ||
12 | | AQUOTE | ||
13 | | SET | ||
14 | |||
15 | let print_stack s = | ||
16 | let b = Buffer.create 100 in | ||
17 | Buffer.add_string b "[ "; | ||
18 | List.iter s ~f:(function | ||
19 | | AQUOTE -> Buffer.add_string b "AQUOTE; " | ||
20 | | SET -> Buffer.add_string b "SET; " | ||
21 | ); | ||
22 | Buffer.add_string b "]"; | ||
23 | Buffer.contents b | ||
24 | |||
25 | let token_of_str state buf = | ||
26 | match state with | ||
27 | | `Start -> STR_START (Buffer.contents buf) | ||
28 | | `Mid -> STR_MID (Buffer.contents buf) | ||
29 | |||
30 | let token_of_istr state buf = | ||
31 | match state with | ||
32 | | `Start -> ISTR_START (Buffer.contents buf) | ||
33 | | `Mid -> ISTR_MID (Buffer.contents buf) | ||
34 | |||
35 | (* lookup table for one-character tokens *) | ||
36 | let char_table = Array.create ~len:94 EOF | ||
37 | let _ = | ||
38 | List.iter ~f:(fun (k, v) -> Array.set char_table ((int_of_char k) - 1) v) | ||
39 | [ | ||
40 | '.', SELECT; | ||
41 | '?', QMARK; | ||
42 | '!', NOT; | ||
43 | '=', ASSIGN; | ||
44 | '<', LT; | ||
45 | '>', GT; | ||
46 | '[', LBRACK; | ||
47 | ']', RBRACK; | ||
48 | '+', PLUS; | ||
49 | '-', MINUS; | ||
50 | '*', TIMES; | ||
51 | '/', SLASH; | ||
52 | '(', LPAREN; | ||
53 | ')', RPAREN; | ||
54 | ':', COLON; | ||
55 | ';', SEMICOLON; | ||
56 | ',', COMMA; | ||
57 | '@', AS | ||
58 | ] | ||
59 | |||
60 | (* lookup table for two- and three-character tokens *) | ||
61 | let str_table = Hashtbl.create (module String) ~size:10 | ||
62 | let _ = | ||
63 | List.iter ~f:(fun (kwd, tok) -> Hashtbl.set str_table ~key:kwd ~data:tok) | ||
64 | [ | ||
65 | "//", MERGE; | ||
66 | "++", CONCAT; | ||
67 | "<=", LTE; | ||
68 | ">=", GTE; | ||
69 | "==", EQ; | ||
70 | "!=", NEQ; | ||
71 | "&&", AND; | ||
72 | "||", OR; | ||
73 | "->", IMPL; | ||
74 | "...", ELLIPSIS | ||
75 | ] | ||
76 | |||
77 | (* lookup table for keywords *) | ||
78 | let keyword_table = Hashtbl.create (module String) ~size:10 | ||
79 | let _ = | ||
80 | List.iter ~f:(fun (kwd, tok) -> Hashtbl.set keyword_table ~key:kwd ~data:tok) | ||
81 | [ "with", WITH; | ||
82 | "rec", REC; | ||
83 | "let", LET; | ||
84 | "in", IN; | ||
85 | "inherit", INHERIT; | ||
86 | "if" , IF; | ||
87 | "then", THEN; | ||
88 | "else", ELSE; | ||
89 | "assert", ASSERT; | ||
90 | "or", ORDEF ] | ||
91 | |||
92 | (* replace an escape sequence by the corresponding character(s) *) | ||
93 | let unescape = function | ||
94 | | "\\n" -> "\n" | ||
95 | | "\\r" -> "\r" | ||
96 | | "\\t" -> "\t" | ||
97 | | "\\\\" -> "\\" | ||
98 | | "\\${" -> "${" | ||
99 | | "''$" -> "$" | ||
100 | | "$$" -> "$" | ||
101 | | "'''" -> "''" | ||
102 | | "''\\t" -> "\t" | ||
103 | | "''\\r" -> "\r" | ||
104 | | "''\\n" -> "\n" | ||
105 | | x -> | ||
106 | failwith (Printf.sprintf "unescape unexpected arg %s" x) | ||
107 | |||
108 | let collect_tokens lexer q lexbuf = | ||
109 | let stack = ref [] in | ||
110 | let queue = Stdlib.Queue.create () in | ||
111 | let rec go () = | ||
112 | match (try Some (Stdlib.Queue.take queue) with Stdlib.Queue.Empty -> None) with | ||
113 | | Some token -> | ||
114 | ( | ||
115 | match token, !stack with | ||
116 | | AQUOTE_CLOSE, [] -> | ||
117 | Stdlib.Queue.add AQUOTE_CLOSE q | ||
118 | | EOF, _ -> | ||
119 | Stdlib.Queue.add EOF q; | ||
120 | | _, _ -> | ||
121 | Stdlib.Queue.add token q; | ||
122 | go () | ||
123 | ) | ||
124 | | None -> | ||
125 | lexer queue stack lexbuf; | ||
126 | go () | ||
127 | in | ||
128 | Stdlib.Queue.add AQUOTE_OPEN q; | ||
129 | stack := [AQUOTE]; | ||
130 | lexer queue stack lexbuf; | ||
131 | go () | ||
132 | |||
133 | (* utility functions *) | ||
134 | let print_position lexbuf = | ||
135 | let pos = Lexing.lexeme_start_p lexbuf in | ||
136 | Printf.sprintf "%s:%d:%d" pos.pos_fname | ||
137 | pos.pos_lnum (pos.pos_cnum - pos.pos_bol + 1) | ||
138 | |||
139 | |||
140 | let set_filename fname (lexbuf: Lexing.lexbuf) = | ||
141 | let pos = lexbuf.lex_curr_p in | ||
142 | lexbuf.lex_curr_p <- { pos with pos_fname = fname }; lexbuf | ||
143 | |||
144 | } | ||
145 | |||
146 | let nzdigit = ['1'-'9'] | ||
147 | let digit = nzdigit | '0' | ||
148 | let float = (nzdigit digit* '.' digit* | '0'? '.' digit+) (['E' 'e'] ['+' '-']? digit+)? | ||
149 | let alpha = ['a'-'z' 'A'-'Z'] | ||
150 | let alpha_digit = alpha | digit | ||
151 | let path_chr = alpha_digit | ['.' '_' '-' '+'] | ||
152 | let path = path_chr* ('/' path_chr+)+ | ||
153 | let spath = alpha_digit path_chr* ('/' path_chr+)* | ||
154 | let uri_chr = ['%' '/' '?' ':' '@' '&' '=' '+' '$' ',' '-' '_' '.' '!' '~' '*' '\''] | ||
155 | let scheme = alpha (alpha | ['+' '-' '.'])* | ||
156 | let uri = scheme ':' (alpha_digit | uri_chr)+ | ||
157 | let char_tokens = ['.' '?' '!' '=' '<' '>' '[' ']' '+' '-' '*' '/' '^' '(' ')' ':' ';' ',' '@'] | ||
158 | |||
159 | rule get_tokens q s = parse | ||
160 | (* skip whitespeces *) | ||
161 | | [' ' '\t' '\r'] | ||
162 | { get_tokens q s lexbuf } | ||
163 | (* increase line count for new lines *) | ||
164 | | '\n' | ||
165 | { Lexing.new_line lexbuf; get_tokens q s lexbuf } | ||
166 | | char_tokens as c | ||
167 | { Stdlib.Queue.add (Array.get char_table ((int_of_char c) - 1)) q } | ||
168 | | ("//" | "++" | "<=" | ">=" | "==" | "!=" | "&&" | "||" | "->" | "...") as s | ||
169 | { Stdlib.Queue.add (Hashtbl.find_exn str_table s) q} | ||
170 | | digit+ as i | ||
171 | { Stdlib.Queue.add (INT i) q } | ||
172 | | float | ||
173 | { Stdlib.Queue.add (FLOAT (Lexing.lexeme lexbuf)) q } | ||
174 | | path | ||
175 | { Stdlib.Queue.add (PATH (Lexing.lexeme lexbuf)) q } | ||
176 | | '<' (spath as p) '>' | ||
177 | { Stdlib.Queue.add (SPATH p) q } | ||
178 | | '~' path as p | ||
179 | { Stdlib.Queue.add (HPATH p) q } | ||
180 | | uri | ||
181 | { Stdlib.Queue.add(URI (Lexing.lexeme lexbuf)) q } | ||
182 | (* keywords or identifiers *) | ||
183 | | ((alpha | '_')+ (alpha_digit | ['_' '\'' '-'])*) as id | ||
184 | { Stdlib.Queue.add (Hashtbl.find keyword_table id |> Option.value ~default:(ID id)) q} | ||
185 | (* comments *) | ||
186 | | '#' ([^ '\n']* as c) | ||
187 | { ignore c; get_tokens q s lexbuf} | ||
188 | | "/*" | ||
189 | { comment (Buffer.create 64) lexbuf; | ||
190 | get_tokens q s lexbuf | ||
191 | } | ||
192 | (* the following three tokens change the braces stack *) | ||
193 | | "${" | ||
194 | { Stdlib.Queue.add AQUOTE_OPEN q; s := AQUOTE :: !s } | ||
195 | | '{' | ||
196 | { Stdlib.Queue.add LBRACE q; s := SET :: !s } | ||
197 | | '}' | ||
198 | { | ||
199 | match !s with | ||
200 | | AQUOTE :: rest -> | ||
201 | Stdlib.Queue.add AQUOTE_CLOSE q; s := rest | ||
202 | | SET :: rest -> | ||
203 | Stdlib.Queue.add RBRACE q; s := rest | ||
204 | | _ -> | ||
205 | let pos = print_position lexbuf in | ||
206 | let err = Printf.sprintf "Unbalanced '}' at %s\n" pos in | ||
207 | raise (Error err) | ||
208 | } | ||
209 | (* a double-quoted string *) | ||
210 | | '"' | ||
211 | { string `Start (Buffer.create 64) q lexbuf } | ||
212 | (* an indented string *) | ||
213 | | "''" (' '+ as ws) | ||
214 | { istring `Start (Some (String.length ws)) (Buffer.create 64) q lexbuf } | ||
215 | | "''" | ||
216 | { istring `Start None (Buffer.create 64) q lexbuf } | ||
217 | (* End of input *) | ||
218 | | eof | ||
219 | { Stdlib.Queue.add EOF q } | ||
220 | (* any other character raises an exception *) | ||
221 | | _ | ||
222 | { | ||
223 | let pos = print_position lexbuf in | ||
224 | let tok = Lexing.lexeme lexbuf in | ||
225 | let err = Printf.sprintf "Unexpected character '%s' at %s\n" tok pos in | ||
226 | raise (Error err) | ||
227 | } | ||
228 | |||
229 | (* Nix does not allow nested comments, but it is still handy to lex it | ||
230 | separately because we can properly increase line count. *) | ||
231 | and comment buf = parse | ||
232 | | '\n' | ||
233 | {Lexing.new_line lexbuf; Buffer.add_char buf '\n'; comment buf lexbuf} | ||
234 | | "*/" | ||
235 | { () } | ||
236 | | _ as c | ||
237 | { Buffer.add_char buf c; comment buf lexbuf } | ||
238 | |||
239 | and string state buf q = parse | ||
240 | | '"' (* terminate when we hit '"' *) | ||
241 | { Stdlib.Queue.add (token_of_str state buf) q; Stdlib.Queue.add STR_END q } | ||
242 | | '\n' | ||
243 | { Lexing.new_line lexbuf; Buffer.add_char buf '\n'; string state buf q lexbuf } | ||
244 | | ("\\n" | "\\r" | "\\t" | "\\\\" | "\\${") as s | ||
245 | { Buffer.add_string buf (unescape s); string state buf q lexbuf } | ||
246 | | "\\" (_ as c) (* add the character verbatim *) | ||
247 | { Buffer.add_char buf c; string state buf q lexbuf } | ||
248 | | "${" (* collect all the tokens till we hit the matching '}' *) | ||
249 | { | ||
250 | Stdlib.Queue.add (token_of_str state buf) q; | ||
251 | collect_tokens get_tokens q lexbuf; | ||
252 | string `Mid (Buffer.create 64) q lexbuf | ||
253 | } | ||
254 | | _ as c (* otherwise just add the character to the buffer *) | ||
255 | { Buffer.add_char buf c; string state buf q lexbuf } | ||
256 | |||
257 | and istring state imin buf q = parse | ||
258 | | ('\n' ' '* "''") | ||
259 | { | ||
260 | Lexing.new_line lexbuf; | ||
261 | Buffer.add_string buf "\n"; | ||
262 | let indent = match imin with | None -> 0 | Some i -> i in | ||
263 | Stdlib.Queue.add (token_of_istr state buf) q; | ||
264 | Stdlib.Queue.add (ISTR_END indent) q | ||
265 | } | ||
266 | | "''" | ||
267 | { | ||
268 | let indent = match imin with | None -> 0 | Some i -> i in | ||
269 | Stdlib.Queue.add (token_of_istr state buf) q; | ||
270 | Stdlib.Queue.add (ISTR_END indent) q | ||
271 | } | ||
272 | | ('\n' ' '* '\n') as s | ||
273 | { | ||
274 | Lexing.new_line lexbuf; | ||
275 | Lexing.new_line lexbuf; | ||
276 | Buffer.add_string buf s; | ||
277 | istring state imin buf q lexbuf | ||
278 | } | ||
279 | | ('\n' (' '* as ws)) as s | ||
280 | { | ||
281 | Lexing.new_line lexbuf; | ||
282 | Buffer.add_string buf s; | ||
283 | let ws_count = String.length ws in | ||
284 | match imin with | ||
285 | | None -> | ||
286 | istring state (Some ws_count) buf q lexbuf | ||
287 | | Some i -> | ||
288 | istring state (Some (min i ws_count)) buf q lexbuf | ||
289 | } | ||
290 | | ("''$" | "'''" | "''\\t" | "''\\r" | "''\\n") as s | ||
291 | { Buffer.add_string buf (unescape s); istring state imin buf q lexbuf } | ||
292 | | "''\\" (_ as c) | ||
293 | { Buffer.add_char buf c; istring state imin buf q lexbuf } | ||
294 | | "${" | ||
295 | { | ||
296 | Stdlib.Queue.add (token_of_istr state buf) q; | ||
297 | collect_tokens get_tokens q lexbuf; | ||
298 | istring `Mid imin (Buffer.create 64) q lexbuf | ||
299 | } | ||
300 | | _ as c | ||
301 | { Buffer.add_char buf c; istring state imin buf q lexbuf } | ||
302 | { | ||
303 | |||
304 | let rec next_token | ||
305 | (q: token Stdlib.Queue.t) | ||
306 | (s: braces list ref) | ||
307 | (lexbuf: Lexing.lexbuf) | ||
308 | : token = | ||
309 | match (try Some (Stdlib.Queue.take q) with | Stdlib.Queue.Empty -> None) with | ||
310 | | Some token -> | ||
311 | token | ||
312 | | None -> | ||
313 | get_tokens q s lexbuf; | ||
314 | next_token q s lexbuf | ||
315 | } | ||
diff --git a/lib/nix/nix.ml b/lib/nix/nix.ml new file mode 100644 index 0000000..39dc94c --- /dev/null +++ b/lib/nix/nix.ml | |||
@@ -0,0 +1,20 @@ | |||
1 | open Core | ||
2 | module Ast = Types | ||
3 | module Printer = Printer | ||
4 | |||
5 | exception ParseError of string | ||
6 | |||
7 | let parse ~filename (data : string) = | ||
8 | let lexbuf = Lexer.set_filename filename (Lexing.from_string data) | ||
9 | and q, s = (Stdlib.Queue.create (), ref []) in | ||
10 | try Parser.main (Lexer.next_token q s) lexbuf with | ||
11 | | Lexer.Error msg -> | ||
12 | let msg' = String.rstrip msg in | ||
13 | raise (ParseError (sprintf "Lexing error: %s" msg')) | ||
14 | | Parser.Error -> | ||
15 | let msg = sprintf "Parse error at %s" (Lexer.print_position lexbuf) in | ||
16 | raise (ParseError msg) | ||
17 | |||
18 | let elaborate = Elaborator.process | ||
19 | |||
20 | exception ElaborateError = Elaborator.ElaborateError | ||
diff --git a/lib/nix/parser.mly b/lib/nix/parser.mly new file mode 100644 index 0000000..dc1638d --- /dev/null +++ b/lib/nix/parser.mly | |||
@@ -0,0 +1,310 @@ | |||
1 | /* Tokens with data */ | ||
2 | %token <string> INT | ||
3 | %token <string> FLOAT | ||
4 | /* A path */ | ||
5 | %token <string> PATH | ||
6 | /* Search path, enclosed in <> */ | ||
7 | %token <string> SPATH | ||
8 | /* Home path, starts with ~ */ | ||
9 | %token <string> HPATH | ||
10 | %token <string> URI | ||
11 | %token <string> STR_START | ||
12 | %token <string> STR_MID | ||
13 | %token STR_END | ||
14 | %token <string> ISTR_START | ||
15 | %token <string> ISTR_MID | ||
16 | %token <int> ISTR_END | ||
17 | %token <string> ID | ||
18 | /* Tokens that stand for themselves */ | ||
19 | %token SELECT "." | ||
20 | %token QMARK "?" | ||
21 | %token CONCAT "++" | ||
22 | %token NOT "!" | ||
23 | %token MERGE "//" | ||
24 | %token ASSIGN "=" | ||
25 | %token LT "<" | ||
26 | %token LTE "<=" | ||
27 | %token GT ">" | ||
28 | %token GTE ">=" | ||
29 | %token EQ "==" | ||
30 | %token NEQ "!=" | ||
31 | %token AND "&&" | ||
32 | %token OR "||" | ||
33 | %token IMPL "->" | ||
34 | %token AQUOTE_OPEN "${" | ||
35 | %token AQUOTE_CLOSE "}$" | ||
36 | %token LBRACE "{" | ||
37 | %token RBRACE "}" | ||
38 | %token LBRACK "[" | ||
39 | %token RBRACK "]" | ||
40 | %token PLUS "+" | ||
41 | %token MINUS "-" | ||
42 | %token TIMES "*" | ||
43 | %token SLASH "/" | ||
44 | %token LPAREN "(" | ||
45 | %token RPAREN ")" | ||
46 | %token COLON ":" | ||
47 | %token SEMICOLON ";" | ||
48 | %token COMMA "," | ||
49 | %token ELLIPSIS "..." | ||
50 | %token AS "@" | ||
51 | /* Keywords */ | ||
52 | %token WITH "with" | ||
53 | %token REC "rec" | ||
54 | %token LET "let" | ||
55 | %token IN "in" | ||
56 | %token INHERIT "inherit" | ||
57 | %token IF "if" | ||
58 | %token THEN "then" | ||
59 | %token ELSE "else" | ||
60 | %token ASSERT "assert" | ||
61 | %token ORDEF "or" | ||
62 | |||
63 | /* End of input */ | ||
64 | %token EOF | ||
65 | |||
66 | %{ | ||
67 | open Types | ||
68 | %} | ||
69 | |||
70 | %start <Types.expr> main | ||
71 | |||
72 | %% | ||
73 | |||
74 | main: | ||
75 | | e = expr0 EOF | ||
76 | { e } | ||
77 | |||
78 | expr0: | ||
79 | | "if"; e1 = expr0; "then"; e2 = expr0; "else"; e3 = expr0 | ||
80 | { Cond (e1, e2, e3) } | ||
81 | | "with"; e1 = expr0; ";"; e2 = expr0 | ||
82 | { With (e1, e2) } | ||
83 | | "assert"; e1 = expr0; ";"; e2 = expr0 | ||
84 | { Assert (e1, e2) } | ||
85 | | "let"; xs = delimited("{", list(binding), "}") | ||
86 | { SetLet xs } | ||
87 | | "let"; xs = list(binding); "in"; e = expr0 | ||
88 | { Let (xs, e) } | ||
89 | | l = lambda | ||
90 | { Val l } | ||
91 | | e = expr1 | ||
92 | { e } | ||
93 | |||
94 | /* Rules expr1-expr14 are almost direct translation of the operator | ||
95 | precedence table: | ||
96 | https://nixos.org/nix/manual/#sec-language-operators */ | ||
97 | |||
98 | %inline binary_expr(Lhs, Op, Rhs): | ||
99 | | lhs = Lhs; op = Op; rhs = Rhs | ||
100 | { BinaryOp (op, lhs, rhs) } | ||
101 | |||
102 | expr1: | ||
103 | | e = binary_expr(expr2, "->" {Impl}, expr1) | ||
104 | | e = expr2 | ||
105 | { e } | ||
106 | |||
107 | expr2: | ||
108 | | e = binary_expr(expr2, "||" {Or}, expr3) | ||
109 | | e = expr3 | ||
110 | { e } | ||
111 | |||
112 | expr3: | ||
113 | | e = binary_expr(expr3, "&&" {And}, expr4) | ||
114 | | e = expr4 | ||
115 | { e } | ||
116 | |||
117 | %inline expr4_ops: | ||
118 | | "==" { Eq } | ||
119 | | "!=" { Neq } | ||
120 | |||
121 | expr4: | ||
122 | | e = binary_expr(expr5, expr4_ops, expr5) | ||
123 | | e = expr5 | ||
124 | { e } | ||
125 | |||
126 | %inline expr5_ops: | ||
127 | | "<" { Lt } | ||
128 | | ">" { Gt } | ||
129 | | "<=" { Lte } | ||
130 | | ">=" { Gte } | ||
131 | |||
132 | expr5: | ||
133 | | e = binary_expr(expr6, expr5_ops, expr6) | ||
134 | | e = expr6 | ||
135 | { e } | ||
136 | |||
137 | expr6: | ||
138 | | e = binary_expr(expr7, "//" {Merge}, expr6) | ||
139 | | e = expr7 | ||
140 | { e } | ||
141 | |||
142 | expr7: | ||
143 | | e = preceded("!", expr7) | ||
144 | { UnaryOp (Not, e) } | ||
145 | | e = expr8 | ||
146 | { e } | ||
147 | |||
148 | %inline expr8_ops: | ||
149 | | "+" { Plus } | ||
150 | | "-" { Minus } | ||
151 | |||
152 | expr8: | ||
153 | | e = binary_expr(expr8, expr8_ops, expr9) | ||
154 | | e = expr9 | ||
155 | { e } | ||
156 | |||
157 | %inline expr9_ops: | ||
158 | | "*" { Mult } | ||
159 | | "/" { Div } | ||
160 | |||
161 | expr9: | ||
162 | | e = binary_expr(expr9, expr9_ops, expr10) | ||
163 | | e = expr10 | ||
164 | { e } | ||
165 | |||
166 | expr10: | ||
167 | | e = binary_expr(expr11, "++" {Concat}, expr10) | ||
168 | | e = expr11 | ||
169 | { e } | ||
170 | |||
171 | expr11: | ||
172 | | e = expr12 "?" p = attr_path | ||
173 | { Test (e, p) } | ||
174 | | e = expr12 | ||
175 | { e } | ||
176 | |||
177 | expr12: | ||
178 | | e = preceded("-", expr13) | ||
179 | { UnaryOp (Negate, e) } | ||
180 | | e = expr13 | ||
181 | { e } | ||
182 | |||
183 | expr13: | ||
184 | | f = expr13; arg = expr14 | ||
185 | { Apply (f, arg) } | ||
186 | | e = expr14 | ||
187 | { e } | ||
188 | |||
189 | %inline selectable: | ||
190 | | s = set | ||
191 | { Val s } | ||
192 | | id = ID | ||
193 | { Id id } | ||
194 | | e = delimited("(", expr0, ")") | ||
195 | { e } | ||
196 | |||
197 | expr14: | ||
198 | | e = selectable; "."; p = attr_path; o = option(preceded("or", expr14)) | ||
199 | { Select (e, p, o) } | ||
200 | | e = atomic_expr; "or" | ||
201 | { Apply (e, Id "or") } | ||
202 | | e = atomic_expr | ||
203 | { e } | ||
204 | |||
205 | atomic_expr: | ||
206 | | id = ID | ||
207 | { Id id } | ||
208 | | v = value | ||
209 | { Val v } | ||
210 | | e = delimited("(", expr0, ")") | ||
211 | { e } | ||
212 | |||
213 | attr_path: | ||
214 | | p = separated_nonempty_list(".", attr_path_component) | ||
215 | { p } | ||
216 | |||
217 | attr_path_component: | ||
218 | | "or" | ||
219 | { Id "or" } | ||
220 | | id = ID | ||
221 | { Id id } | ||
222 | | e = delimited("${", expr0, "}$") | ||
223 | { Aquote e } | ||
224 | | s = str | ||
225 | { Val s } | ||
226 | |||
227 | value: | ||
228 | | s = str | ||
229 | { s } | ||
230 | | s = istr | ||
231 | { s } | ||
232 | | i = INT | ||
233 | {Int i} | ||
234 | | f = FLOAT | ||
235 | { Float f } | ||
236 | | p = PATH | ||
237 | { Path p } | ||
238 | | sp = SPATH | ||
239 | { SPath sp } | ||
240 | | hp = HPATH | ||
241 | { HPath hp } | ||
242 | | uri = URI | ||
243 | { Uri uri } | ||
244 | | l = nixlist | ||
245 | { l } | ||
246 | | s = set | ||
247 | { s } | ||
248 | |||
249 | %inline str_mid(X): | ||
250 | | xs = list(pair(delimited("${", expr0, "}$"), X)) { xs } | ||
251 | |||
252 | /* Double-quoted string */ | ||
253 | str: | ||
254 | | start = STR_START; mids = str_mid(STR_MID); STR_END | ||
255 | { Str (start, mids) } | ||
256 | |||
257 | /* Indented string */ | ||
258 | istr: | ||
259 | | start = ISTR_START; mids = str_mid(ISTR_MID); i = ISTR_END | ||
260 | { IStr (i, start, mids) } | ||
261 | |||
262 | /* Lists and sets */ | ||
263 | nixlist: | ||
264 | | xs = delimited("[", list(expr14), "]") | ||
265 | { List xs } | ||
266 | |||
267 | empty_set: | ||
268 | | "{"; "}" {} | ||
269 | |||
270 | set: | ||
271 | | empty_set | ||
272 | { AttSet (Nonrec, []) } | ||
273 | | xs = delimited("{", nonempty_list(binding), "}") | ||
274 | { AttSet (Nonrec, xs) } | ||
275 | | xs = preceded("rec", delimited("{", list(binding), "}")) | ||
276 | { AttSet (Rec, xs) } | ||
277 | |||
278 | binding: | ||
279 | | kv = terminated(separated_pair(attr_path, "=", expr0), ";") | ||
280 | { let (k, v) = kv in AttrPath (k, v) } | ||
281 | | xs = delimited("inherit", pair(option(delimited("(", expr0, ")")), list(attr_path_component)), ";") | ||
282 | { let (prefix, ids) = xs in Inherit (prefix, ids) } | ||
283 | |||
284 | lambda: | ||
285 | | id = ID; "@"; p = param_set; ":"; e = expr0 | ||
286 | { Lambda (ParamSet (Some id, p), e) } | ||
287 | | p = param_set; "@"; id = ID; ":"; e = expr0 | ||
288 | { Lambda (ParamSet (Some id, p), e) } | ||
289 | | p = param_set; ":"; e = expr0 | ||
290 | { Lambda (ParamSet (None, p), e) } | ||
291 | | id = ID; ":"; e = expr0 | ||
292 | { Lambda (Alias id, e) } | ||
293 | |||
294 | %inline param_set: | ||
295 | | empty_set | ||
296 | { ([], Exact) } | ||
297 | | "{"; "..."; "}" | ||
298 | { ([], Loose) } | ||
299 | | ps = delimited("{", pair(pair(params, ","?), boption("...")), "}") | ||
300 | { let ((ps, _), ellipsis) = ps in (ps, if ellipsis then Loose else Exact) } | ||
301 | |||
302 | params: | ||
303 | | p = param | ||
304 | { [p] } | ||
305 | | ps = params; ","; p = param | ||
306 | { ps @ [p] } | ||
307 | |||
308 | %inline param: | ||
309 | p = pair(ID, option(preceded("?", expr0))) | ||
310 | { p } | ||
diff --git a/lib/nix/printer.ml b/lib/nix/printer.ml new file mode 100644 index 0000000..57e81f4 --- /dev/null +++ b/lib/nix/printer.ml | |||
@@ -0,0 +1,176 @@ | |||
1 | open Core | ||
2 | open Types | ||
3 | open PPrint | ||
4 | |||
5 | let rec escape_chlist = function | ||
6 | | [] -> [] | ||
7 | | '$' :: '{' :: l' -> '\\' :: '$' :: '{' :: escape_chlist l' | ||
8 | | '\n' :: l' -> '\\' :: 'n' :: escape_chlist l' | ||
9 | | '\r' :: l' -> '\\' :: 'r' :: escape_chlist l' | ||
10 | | '\t' :: l' -> '\\' :: 't' :: escape_chlist l' | ||
11 | | '\\' :: l' -> '\\' :: '\\' :: escape_chlist l' | ||
12 | | '"' :: l' -> '\\' :: '"' :: escape_chlist l' | ||
13 | | c :: l' -> c :: escape_chlist l' | ||
14 | |||
15 | let escape_string s = s |> String.to_list |> escape_chlist |> String.of_list | ||
16 | let out_width = ref 80 | ||
17 | let set_width i = out_width := i | ||
18 | let indent = ref 2 | ||
19 | let set_indent i = indent := i | ||
20 | |||
21 | let rec doc_of_expr = function | ||
22 | | BinaryOp (op, lhs, rhs) -> | ||
23 | let lhs_doc = maybe_parens_bop op `Left lhs | ||
24 | and rhs_doc = maybe_parens_bop op `Right rhs in | ||
25 | infix !indent 1 (doc_of_bop op) lhs_doc rhs_doc | ||
26 | | UnaryOp (op, e) -> precede (doc_of_uop op) (maybe_parens (prec_of_uop op) e) | ||
27 | | Cond (e1, e2, e3) -> | ||
28 | surround !indent 1 | ||
29 | (soft_surround !indent 1 (string "if") (doc_of_expr e1) (string "then")) | ||
30 | (doc_of_expr e2) | ||
31 | (string "else" ^^ nest !indent (break 1 ^^ doc_of_expr e3)) | ||
32 | | With (e1, e2) -> | ||
33 | flow (break 1) [ string "with"; doc_of_expr e1 ^^ semi; doc_of_expr e2 ] | ||
34 | | Assert (e1, e2) -> | ||
35 | flow (break 1) [ string "assert"; doc_of_expr e1 ^^ semi; doc_of_expr e2 ] | ||
36 | | Test (e, path) -> | ||
37 | maybe_parens 4 e ^^ space ^^ string "?" | ||
38 | ^^ group (break 1 ^^ separate_map dot doc_of_expr path) | ||
39 | | SetLet bs -> | ||
40 | surround !indent 1 | ||
41 | (string "let " ^^ lbrace) | ||
42 | (group (separate_map (break 1) doc_of_binding bs)) | ||
43 | rbrace | ||
44 | | Let (bs, e) -> | ||
45 | surround !indent 1 (string "let") | ||
46 | (separate_map (break 1) doc_of_binding bs) | ||
47 | (prefix !indent 1 (string "in") (doc_of_expr e)) | ||
48 | | Val v -> doc_of_val v | ||
49 | | Id id -> string id | ||
50 | | Select (e, path, oe) -> | ||
51 | maybe_parens 1 e ^^ dot ^^ doc_of_attpath path | ||
52 | ^^ optional | ||
53 | (fun e -> | ||
54 | space ^^ string "or" ^^ nest !indent (break 1 ^^ maybe_parens 1 e)) | ||
55 | oe | ||
56 | | Apply (e1, e2) -> prefix !indent 1 (maybe_parens 2 e1) (maybe_parens 2 e2) | ||
57 | | Aquote e -> surround !indent 0 (string "${") (doc_of_expr e) (string "}") | ||
58 | |||
59 | and maybe_parens lvl e = | ||
60 | if prec_of_expr e >= lvl then surround !indent 0 lparen (doc_of_expr e) rparen | ||
61 | else doc_of_expr e | ||
62 | |||
63 | and maybe_parens_bop op (loc : [ `Left | `Right ]) e = | ||
64 | match (loc, assoc_of_bop op) with | ||
65 | | (`Left, Some Left | `Right, Some Right) | ||
66 | when prec_of_expr e >= prec_of_bop op -> | ||
67 | doc_of_expr e | ||
68 | | _, _ -> maybe_parens (prec_of_bop op) e | ||
69 | |||
70 | and doc_of_attpath path = separate_map dot doc_of_expr path | ||
71 | |||
72 | and doc_of_paramset (params, kind) = | ||
73 | let ps = | ||
74 | List.map ~f:doc_of_param params | ||
75 | @ if Poly.(kind = Loose) then [ string "..." ] else [] | ||
76 | in | ||
77 | surround !indent 0 lbrace (separate (comma ^^ break 1) ps) rbrace | ||
78 | |||
79 | and doc_of_param (id, oe) = | ||
80 | string id ^^ optional (fun e -> qmark ^^ space ^^ doc_of_expr e) oe | ||
81 | |||
82 | and doc_of_binding = function | ||
83 | | AttrPath (path, e) -> | ||
84 | doc_of_attpath path ^^ space ^^ equals ^^ space ^^ doc_of_expr e ^^ semi | ||
85 | | Inherit (oe, ids) -> | ||
86 | let id_docs = | ||
87 | List.map | ||
88 | ~f:(function | ||
89 | | Id x | Val (Str (x, [])) -> string x | _ -> assert false) | ||
90 | ids | ||
91 | in | ||
92 | let xs = | ||
93 | flow (break 1) | ||
94 | (match oe with | ||
95 | | Some e -> parens (doc_of_expr e) :: id_docs | ||
96 | | None -> id_docs) | ||
97 | in | ||
98 | soft_surround !indent 0 (string "inherit" ^^ space) xs semi | ||
99 | |||
100 | and doc_of_bop = function | ||
101 | | Plus -> plus | ||
102 | | Minus -> minus | ||
103 | | Mult -> star | ||
104 | | Div -> slash | ||
105 | | Gt -> rangle | ||
106 | | Lt -> langle | ||
107 | | Lte -> string "<=" | ||
108 | | Gte -> string ">=" | ||
109 | | Eq -> string "==" | ||
110 | | Neq -> string "!=" | ||
111 | | Or -> string "||" | ||
112 | | And -> string "&&" | ||
113 | | Impl -> string "->" | ||
114 | | Merge -> string "//" | ||
115 | | Concat -> string "++" | ||
116 | |||
117 | and doc_of_uop = function Negate -> minus | Not -> bang | ||
118 | |||
119 | and doc_of_val = function | ||
120 | | Str (start, xs) -> | ||
121 | dquotes | ||
122 | (string (escape_string start) | ||
123 | ^^ concat | ||
124 | (List.map | ||
125 | ~f:(fun (e, s) -> | ||
126 | surround !indent 0 (string "${") (doc_of_expr e) | ||
127 | (string "}" ^^ string (escape_string s))) | ||
128 | xs)) | ||
129 | | IStr (i, start, xs) -> | ||
130 | let qq = string "''" in | ||
131 | let str s = | ||
132 | String.split ~on:'\n' s | ||
133 | |> List.map ~f:(fun s -> | ||
134 | let len = String.length s in | ||
135 | let s' = | ||
136 | if len >= i then String.sub s ~pos:i ~len:(len - i) else s | ||
137 | in | ||
138 | string s') | ||
139 | |> separate hardline | ||
140 | in | ||
141 | enclose qq qq | ||
142 | (str start | ||
143 | ^^ concat | ||
144 | (List.map | ||
145 | ~f:(fun (e, s) -> | ||
146 | enclose (string "${") rbrace (doc_of_expr e) ^^ str s) | ||
147 | xs)) | ||
148 | | Int x | Float x | Path x | SPath x | HPath x | Uri x -> string x | ||
149 | | Lambda (pattern, body) -> | ||
150 | let pat = | ||
151 | match pattern with | ||
152 | | Alias id -> string id | ||
153 | | ParamSet (None, ps) -> doc_of_paramset ps | ||
154 | | ParamSet (Some id, ps) -> | ||
155 | doc_of_paramset ps ^^ group (break 1 ^^ at ^^ break 1 ^^ string id) | ||
156 | in | ||
157 | flow (break 1) [ pat ^^ colon; doc_of_expr body ] | ||
158 | | List [] -> lbracket ^^ space ^^ rbracket | ||
159 | | List es -> | ||
160 | surround !indent 1 lbracket | ||
161 | (separate_map (break 1) (maybe_parens 2) es) | ||
162 | rbracket | ||
163 | | AttSet (Nonrec, []) -> lbrace ^^ space ^^ rbrace | ||
164 | | AttSet (Nonrec, bs) -> | ||
165 | surround !indent 1 lbrace | ||
166 | (group (separate_map (break 1) doc_of_binding bs)) | ||
167 | rbrace | ||
168 | | AttSet (Rec, bs) -> | ||
169 | string "rec" ^^ space ^^ doc_of_val (AttSet (Nonrec, bs)) | ||
170 | |||
171 | let print chan expr = ToChannel.pretty 0.7 !out_width chan (doc_of_expr expr) | ||
172 | |||
173 | let to_string expr = | ||
174 | let buf = Stdlib.Buffer.create 0 in | ||
175 | ToBuffer.pretty 0.7 !out_width buf (doc_of_expr expr); | ||
176 | Stdlib.Buffer.contents buf | ||
diff --git a/lib/nix/tokens.ml b/lib/nix/tokens.ml new file mode 100644 index 0000000..4891d48 --- /dev/null +++ b/lib/nix/tokens.ml | |||
@@ -0,0 +1,64 @@ | |||
1 | type token = | ||
2 | (* Tokens with data *) | ||
3 | | INT of string | ||
4 | | FLOAT of string | ||
5 | (* A path (starting with / or ./) *) | ||
6 | | PATH of string | ||
7 | (* Search path, enclosed in < and > *) | ||
8 | | SPATH of string | ||
9 | (* Home path, starting with ~/ *) | ||
10 | | HPATH of string | ||
11 | | URI of string | ||
12 | | STR_START of string | ||
13 | | STR_MID of string | ||
14 | | STR_END | ||
15 | | ISTR_START of string | ||
16 | | ISTR_MID of string | ||
17 | | ISTR_END of int | ||
18 | | ID of string | ||
19 | (* Tokens that stand for themselves *) | ||
20 | | SELECT | ||
21 | | QMARK | ||
22 | | CONCAT | ||
23 | | NOT | ||
24 | | MERGE | ||
25 | | ASSIGN | ||
26 | | LT | ||
27 | | LTE | ||
28 | | GT | ||
29 | | GTE | ||
30 | | EQ | ||
31 | | NEQ | ||
32 | | AND | ||
33 | | OR | ||
34 | | IMPL | ||
35 | | AQUOTE_OPEN | ||
36 | | AQUOTE_CLOSE | ||
37 | | LBRACE | ||
38 | | RBRACE | ||
39 | | LBRACK | ||
40 | | RBRACK | ||
41 | | PLUS | ||
42 | | MINUS | ||
43 | | TIMES | ||
44 | | SLASH | ||
45 | | LPAREN | ||
46 | | RPAREN | ||
47 | | COLON | ||
48 | | SEMICOLON | ||
49 | | COMMA | ||
50 | | ELLIPSIS | ||
51 | | AS | ||
52 | (* Keywords *) | ||
53 | | WITH | ||
54 | | REC | ||
55 | | LET | ||
56 | | IN | ||
57 | | INHERIT | ||
58 | | IF | ||
59 | | THEN | ||
60 | | ELSE | ||
61 | | ASSERT | ||
62 | | ORDEF | ||
63 | (* End of input *) | ||
64 | | EOF | ||
diff --git a/lib/nix/types.ml b/lib/nix/types.ml new file mode 100644 index 0000000..8245406 --- /dev/null +++ b/lib/nix/types.ml | |||
@@ -0,0 +1,112 @@ | |||
1 | open Core | ||
2 | |||
3 | (* Binary operators *) | ||
4 | type binary_op = | ||
5 | | Plus | ||
6 | | Minus | ||
7 | | Mult | ||
8 | | Div | ||
9 | | Gt | ||
10 | | Lt | ||
11 | | Lte | ||
12 | | Gte | ||
13 | | Eq | ||
14 | | Neq | ||
15 | | Or | ||
16 | | And | ||
17 | | Impl | ||
18 | | Merge | ||
19 | | Concat | ||
20 | [@@deriving sexp_of] | ||
21 | |||
22 | (* Unary operators *) | ||
23 | type unary_op = Negate | Not [@@deriving sexp_of] | ||
24 | |||
25 | (* The top-level expression type *) | ||
26 | type expr = | ||
27 | | BinaryOp of binary_op * expr * expr | ||
28 | | UnaryOp of unary_op * expr | ||
29 | | Cond of expr * expr * expr | ||
30 | | With of expr * expr | ||
31 | | Assert of expr * expr | ||
32 | | Test of expr * expr list | ||
33 | | SetLet of binding list | ||
34 | | Let of binding list * expr | ||
35 | | Val of value | ||
36 | | Id of id | ||
37 | | Select of expr * expr list * expr option | ||
38 | | Apply of expr * expr | ||
39 | | Aquote of expr | ||
40 | [@@deriving sexp_of] | ||
41 | |||
42 | (* Possible values *) | ||
43 | and value = | ||
44 | (* Str is a string start, followed by arbitrary number of antiquotations and | ||
45 | strings that separate them *) | ||
46 | | Str of string * (expr * string) list | ||
47 | (* IStr is an indented string, so it has the extra integer component which | ||
48 | indicates the indentation *) | ||
49 | | IStr of int * string * (expr * string) list | ||
50 | | Int of string | ||
51 | | Float of string | ||
52 | | Path of string | ||
53 | | SPath of string | ||
54 | | HPath of string | ||
55 | | Uri of string | ||
56 | | Lambda of pattern * expr | ||
57 | | List of expr list | ||
58 | | AttSet of recursivity * binding list | ||
59 | [@@deriving sexp_of] | ||
60 | |||
61 | (* Patterns in lambda definitions *) | ||
62 | and pattern = Alias of id | ParamSet of id option * param_set | ||
63 | [@@deriving sexp_of] | ||
64 | |||
65 | and param_set = param list * match_kind [@@deriving sexp_of] | ||
66 | and param = id * expr option [@@deriving sexp_of] | ||
67 | and recursivity = Rec | Nonrec | ||
68 | and match_kind = Exact | Loose | ||
69 | |||
70 | (* Bindings in attribute sets and let expressions *) | ||
71 | and binding = | ||
72 | (* The first expr should be attrpath, which is the same as in Select *) | ||
73 | | AttrPath of expr list * expr | ||
74 | | Inherit of expr option * expr list | ||
75 | [@@deriving sexp_of] | ||
76 | |||
77 | (* Identifiers *) | ||
78 | and id = string | ||
79 | |||
80 | (* Precedence levels of binary operators *) | ||
81 | let prec_of_bop = function | ||
82 | | Concat -> 5 | ||
83 | | Mult | Div -> 6 | ||
84 | | Plus | Minus -> 7 | ||
85 | | Merge -> 9 | ||
86 | | Gt | Lt | Lte | Gte -> 10 | ||
87 | | Eq | Neq -> 11 | ||
88 | | And -> 12 | ||
89 | | Or -> 13 | ||
90 | | Impl -> 14 | ||
91 | |||
92 | type assoc = Left | Right | ||
93 | |||
94 | let assoc_of_bop = function | ||
95 | | Mult | Div | Plus | Minus -> Some Left | ||
96 | | Concat | Merge | And | Or -> Some Right | ||
97 | | Gt | Lt | Lte | Gte | Eq | Neq | Impl -> None | ||
98 | |||
99 | (* Precedence levels of unary operators *) | ||
100 | let prec_of_uop = function Negate -> 3 | Not -> 8 | ||
101 | |||
102 | (* Precedence level of expressions | ||
103 | (assuming that the constituents have higher levels) *) | ||
104 | let prec_of_expr = function | ||
105 | | Val (Lambda _) -> 15 | ||
106 | | Val _ | Id _ | Aquote _ -> 0 | ||
107 | | BinaryOp (op, _, _) -> prec_of_bop op | ||
108 | | UnaryOp (op, _) -> prec_of_uop op | ||
109 | | Cond _ | With _ | Assert _ | Let _ | SetLet _ -> 15 | ||
110 | | Test _ -> 4 | ||
111 | | Select _ -> 1 | ||
112 | | Apply _ -> 2 | ||
diff --git a/mininix.opam b/mininix.opam new file mode 100644 index 0000000..f28f0cb --- /dev/null +++ b/mininix.opam | |||
@@ -0,0 +1,39 @@ | |||
1 | # This file is generated by dune, edit dune-project instead | ||
2 | opam-version: "2.0" | ||
3 | authors: ["Anonymous Authors"] | ||
4 | license: "LICENSE" | ||
5 | depends: [ | ||
6 | "dune" {>= "3.15"} | ||
7 | "ocaml" {< "5"} | ||
8 | "coq" {>= "8.20" & < "8.21"} | ||
9 | "coq-stdpp" {>= "1.11" & < "1.12"} | ||
10 | "coq-flocq" | ||
11 | "core" | ||
12 | "core_unix" | ||
13 | "linenoise" | ||
14 | "menhir" | ||
15 | "pprint" | ||
16 | "sexp_pretty" | ||
17 | "stdio" | ||
18 | "ppx_sexp_conv" | ||
19 | "ppx_blob" | ||
20 | "ppx_let" | ||
21 | "bisect_ppx" | ||
22 | "merlin" {dev} | ||
23 | "ocamlformat" {dev} | ||
24 | "odoc" {with-doc} | ||
25 | ] | ||
26 | build: [ | ||
27 | ["dune" "subst"] {dev} | ||
28 | [ | ||
29 | "dune" | ||
30 | "build" | ||
31 | "-p" | ||
32 | name | ||
33 | "-j" | ||
34 | jobs | ||
35 | "@install" | ||
36 | "@runtest" {with-test} | ||
37 | "@doc" {with-doc} | ||
38 | ] | ||
39 | ] | ||
diff --git a/mininix.opam.locked b/mininix.opam.locked new file mode 100644 index 0000000..3cabd84 --- /dev/null +++ b/mininix.opam.locked | |||
@@ -0,0 +1,131 @@ | |||
1 | opam-version: "2.0" | ||
2 | name: "mininix" | ||
3 | version: "dev" | ||
4 | authors: "Anonymous Authors" | ||
5 | license: "LICENSE" | ||
6 | depends: [ | ||
7 | "astring" {= "0.8.5" & with-doc} | ||
8 | "base" {= "v0.16.3"} | ||
9 | "base-bigarray" {= "base"} | ||
10 | "base-threads" {= "base"} | ||
11 | "base-unix" {= "base"} | ||
12 | "base_bigstring" {= "v0.16.0"} | ||
13 | "base_quickcheck" {= "v0.16.0"} | ||
14 | "bin_prot" {= "v0.16.0"} | ||
15 | "bisect_ppx" {= "2.8.3"} | ||
16 | "camlp-streams" {= "5.0.1" & with-doc} | ||
17 | "cmdliner" {= "1.3.0"} | ||
18 | "conf-bash" {= "1"} | ||
19 | "conf-g++" {= "1.0"} | ||
20 | "conf-gmp" {= "4"} | ||
21 | "conf-linux-libc-dev" {= "0"} | ||
22 | "conf-pkg-config" {= "4"} | ||
23 | "coq" {= "8.20.1"} | ||
24 | "coq-core" {= "8.20.1"} | ||
25 | "coq-flocq" {= "4.2.0"} | ||
26 | "coq-stdlib" {= "8.20.1"} | ||
27 | "coq-stdpp" {= "1.11.0"} | ||
28 | "coqide-server" {= "8.20.1"} | ||
29 | "core" {= "v0.16.2"} | ||
30 | "core_kernel" {= "v0.16.0"} | ||
31 | "core_unix" {= "v0.16.0"} | ||
32 | "cppo" {= "1.8.0" & with-doc} | ||
33 | "crunch" {= "3.3.1" & with-doc} | ||
34 | "csexp" {= "1.5.2"} | ||
35 | "dune" {= "3.17.2"} | ||
36 | "dune-configurator" {= "3.17.2"} | ||
37 | "expect_test_helpers_core" {= "v0.16.0"} | ||
38 | "fieldslib" {= "v0.16.0"} | ||
39 | "fmt" {= "0.9.0" & with-doc} | ||
40 | "fpath" {= "0.7.3" & with-doc} | ||
41 | "int_repr" {= "v0.16.0"} | ||
42 | "jane-street-headers" {= "v0.16.0"} | ||
43 | "jst-config" {= "v0.16.0"} | ||
44 | "linenoise" {= "1.5.1"} | ||
45 | "menhir" {= "20240715"} | ||
46 | "menhirCST" {= "20240715"} | ||
47 | "menhirLib" {= "20240715"} | ||
48 | "menhirSdk" {= "20240715"} | ||
49 | "num" {= "1.5-1"} | ||
50 | "ocaml" {= "4.14.2"} | ||
51 | "ocaml-base-compiler" {= "4.14.2"} | ||
52 | "ocaml-compiler-libs" {= "v0.12.4"} | ||
53 | "ocaml-config" {= "2"} | ||
54 | "ocaml-options-vanilla" {= "1"} | ||
55 | "ocaml_intrinsics" {= "v0.16.1"} | ||
56 | "ocamlbuild" {= "0.15.0" & with-doc} | ||
57 | "ocamlfind" {= "1.9.6"} | ||
58 | "odoc" {= "2.4.4" & with-doc} | ||
59 | "odoc-parser" {= "2.4.4" & with-doc} | ||
60 | "parsexp" {= "v0.16.0"} | ||
61 | "pprint" {= "20230830"} | ||
62 | "ppx_assert" {= "v0.16.0"} | ||
63 | "ppx_base" {= "v0.16.0"} | ||
64 | "ppx_bench" {= "v0.16.0"} | ||
65 | "ppx_bin_prot" {= "v0.16.0"} | ||
66 | "ppx_blob" {= "0.9.0"} | ||
67 | "ppx_cold" {= "v0.16.0"} | ||
68 | "ppx_compare" {= "v0.16.0"} | ||
69 | "ppx_custom_printf" {= "v0.16.0"} | ||
70 | "ppx_derivers" {= "1.2.1"} | ||
71 | "ppx_disable_unused_warnings" {= "v0.16.0"} | ||
72 | "ppx_enumerate" {= "v0.16.0"} | ||
73 | "ppx_expect" {= "v0.16.1"} | ||
74 | "ppx_fields_conv" {= "v0.16.0"} | ||
75 | "ppx_fixed_literal" {= "v0.16.0"} | ||
76 | "ppx_globalize" {= "v0.16.0"} | ||
77 | "ppx_hash" {= "v0.16.0"} | ||
78 | "ppx_here" {= "v0.16.0"} | ||
79 | "ppx_ignore_instrumentation" {= "v0.16.0"} | ||
80 | "ppx_inline_test" {= "v0.16.1"} | ||
81 | "ppx_jane" {= "v0.16.0"} | ||
82 | "ppx_let" {= "v0.16.0"} | ||
83 | "ppx_log" {= "v0.16.0"} | ||
84 | "ppx_module_timer" {= "v0.16.0"} | ||
85 | "ppx_optcomp" {= "v0.16.0"} | ||
86 | "ppx_optional" {= "v0.16.0"} | ||
87 | "ppx_pipebang" {= "v0.16.0"} | ||
88 | "ppx_sexp_conv" {= "v0.16.0"} | ||
89 | "ppx_sexp_message" {= "v0.16.0"} | ||
90 | "ppx_sexp_value" {= "v0.16.0"} | ||
91 | "ppx_stable" {= "v0.16.0"} | ||
92 | "ppx_stable_witness" {= "v0.16.0"} | ||
93 | "ppx_string" {= "v0.16.0"} | ||
94 | "ppx_tydi" {= "v0.16.0"} | ||
95 | "ppx_typerep_conv" {= "v0.16.0"} | ||
96 | "ppx_variants_conv" {= "v0.16.0"} | ||
97 | "ppxlib" {= "0.34.0"} | ||
98 | "ptime" {= "1.2.0" & with-doc} | ||
99 | "re" {= "1.12.0"} | ||
100 | "result" {= "1.5" & with-doc} | ||
101 | "seq" {= "base"} | ||
102 | "sexp_pretty" {= "v0.16.0"} | ||
103 | "sexplib" {= "v0.16.0"} | ||
104 | "sexplib0" {= "v0.16.0"} | ||
105 | "spawn" {= "v0.17.0"} | ||
106 | "splittable_random" {= "v0.16.0"} | ||
107 | "stdio" {= "v0.16.0"} | ||
108 | "stdlib-shims" {= "0.3.0"} | ||
109 | "time_now" {= "v0.16.0"} | ||
110 | "timezone" {= "v0.16.0"} | ||
111 | "topkg" {= "1.0.7" & with-doc} | ||
112 | "typerep" {= "v0.16.0"} | ||
113 | "tyxml" {= "4.6.0" & with-doc} | ||
114 | "uutf" {= "1.0.3" & with-doc} | ||
115 | "variantslib" {= "v0.16.0"} | ||
116 | "zarith" {= "1.14"} | ||
117 | ] | ||
118 | build: [ | ||
119 | ["dune" "subst"] {dev} | ||
120 | [ | ||
121 | "dune" | ||
122 | "build" | ||
123 | "-p" | ||
124 | name | ||
125 | "-j" | ||
126 | jobs | ||
127 | "@install" | ||
128 | "@runtest" {with-test} | ||
129 | "@doc" {with-doc} | ||
130 | ] | ||
131 | ] \ No newline at end of file | ||
diff --git a/nixpkgs-pinned.nix b/nixpkgs-pinned.nix new file mode 100644 index 0000000..00ca388 --- /dev/null +++ b/nixpkgs-pinned.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | import (builtins.fetchTarball { | ||
2 | name = "nixos-25.05"; | ||
3 | # Nixpkgs 25.05 at 2025-05-06 19:25 UTC | ||
4 | # Please keep in sync with the locked version for the flake | ||
5 | url = "https://github.com/NixOS/nixpkgs/archive/70c74b02eac46f4e4aa071e45a6189ce0f6d9265.tar.gz"; | ||
6 | sha256 = "0b4jz58kkm7dbq6c6fmbgrh29smchhs6d96czhms7wddlni1m71p"; | ||
7 | }) | ||
diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..464969d --- /dev/null +++ b/shell.nix | |||
@@ -0,0 +1,21 @@ | |||
1 | { pkgs ? import ./nixpkgs-pinned.nix {} }: | ||
2 | let ocamlPackages = pkgs.ocaml-ng.ocamlPackages_4_14; in | ||
3 | pkgs.mkShell { | ||
4 | inputsFrom = [ (import ./coverage.nix { inherit pkgs; }) ]; | ||
5 | buildInputs = with pkgs; [ | ||
6 | bash | ||
7 | cloc | ||
8 | git | ||
9 | jq | ||
10 | tree | ||
11 | (python3.withPackages (pkgs: [ pkgs.pygments ])) | ||
12 | coqPackages_8_20.coq | ||
13 | coqPackages_8_20.coq-lsp | ||
14 | coqPackages_8_20.vscoq-language-server | ||
15 | ocamlPackages.ocaml-lsp | ||
16 | ocamlPackages.ocamlformat | ||
17 | ocamlPackages.odoc | ||
18 | ocamlPackages.utop | ||
19 | ocamlPackages.merlin | ||
20 | ]; | ||
21 | } | ||
diff --git a/test/dune b/test/dune new file mode 100644 index 0000000..8726c07 --- /dev/null +++ b/test/dune | |||
@@ -0,0 +1,7 @@ | |||
1 | (test | ||
2 | (name test_mininix) | ||
3 | (libraries core core_unix core_unix.filename_unix nix mininix) | ||
4 | (preprocess | ||
5 | (pps ppx_sexp_conv ppx_expect)) | ||
6 | (deps | ||
7 | (glob_files_rec testdata/*.{nix,exp}))) | ||
diff --git a/test/test_mininix.ml b/test/test_mininix.ml new file mode 100644 index 0000000..f628a8a --- /dev/null +++ b/test/test_mininix.ml | |||
@@ -0,0 +1,319 @@ | |||
1 | open Core | ||
2 | |||
3 | let with_dir path ~f = | ||
4 | let fd = Core_unix.opendir path in | ||
5 | f fd; | ||
6 | Core_unix.closedir fd | ||
7 | |||
8 | let walk_dir path ~f = | ||
9 | with_dir path ~f:(fun fd -> | ||
10 | let rec go () = | ||
11 | match Core_unix.readdir_opt fd with | ||
12 | | Some entry -> | ||
13 | f (Filename.concat path entry); | ||
14 | go () | ||
15 | | None -> () | ||
16 | in | ||
17 | go ()) | ||
18 | |||
19 | type testcase = { | ||
20 | name : string; | ||
21 | dir : string; | ||
22 | input : string; | ||
23 | expected_output : [ `Okay of string | `Fail ]; | ||
24 | } | ||
25 | |||
26 | let testdata_dir = "./testdata" | ||
27 | and testcases = ref [] | ||
28 | and testcases_ignored = ref 0 | ||
29 | |||
30 | let add_testcase c = testcases := c :: !testcases | ||
31 | |||
32 | let print_testcase_stats () = | ||
33 | let okay, fail = | ||
34 | List.fold !testcases ~init:(0, 0) | ||
35 | ~f:(fun (okay, fail) { expected_output; _ } -> | ||
36 | match expected_output with | ||
37 | | `Okay _ -> (okay + 1, fail) | ||
38 | | `Fail -> (okay, fail + 1)) | ||
39 | in | ||
40 | printf | ||
41 | "Loaded %d test cases (ignored %d), expected results: okay %d, fail %d\n%!" | ||
42 | (okay + fail) !testcases_ignored okay fail | ||
43 | |||
44 | let imports () = | ||
45 | Mininix.Import.materialize | ||
46 | [ { filename = "./testdata/lib.nix"; deps = [] } ] | ||
47 | ~relative_to:(Core_unix.getcwd ()) | ||
48 | |||
49 | type eval_err = [ `Timeout | `ParseError | `ProgramError | `ElaborateError ] | ||
50 | [@@deriving sexp] | ||
51 | |||
52 | type eval_result = (string, eval_err) Result.t [@@deriving sexp] | ||
53 | |||
54 | let eval input ~name ~dir ~imports = | ||
55 | let dir = Filename.to_absolute_exn dir ~relative_to:(Core_unix.getcwd ()) in | ||
56 | try | ||
57 | input | ||
58 | |> Nix.parse ~filename:(name ^ ".nix") | ||
59 | |> Nix.elaborate ~dir:(Some dir) | ||
60 | |> Mininix.Nix2mininix.from_nix |> Mininix.apply_prelude | ||
61 | |> Mininix.interp_tl ~fuel:`Limited ~mode:`Deep ~imports | ||
62 | |> function | ||
63 | | Res (Some v) -> | ||
64 | Ok (v |> Mininix.Mininix2nix.from_val |> Nix.Printer.to_string) | ||
65 | | Res None -> Error `ProgramError | ||
66 | | NoFuel -> Error `Timeout | ||
67 | with | ||
68 | | Nix.ParseError _ -> Error `ParseError | ||
69 | | Nix.ElaborateError _ -> Error `ElaborateError | ||
70 | | Mininix.Nix2mininix.FromNixError _ -> Error `ElaborateError | ||
71 | |||
72 | let eval_subproc input ~name ~dir ~imports = | ||
73 | let rxfd, txfd = Core_unix.pipe () in | ||
74 | match Core_unix.fork () with | ||
75 | | `In_the_child -> | ||
76 | let txc = Core_unix.out_channel_of_descr txfd in | ||
77 | eval input ~name ~dir ~imports | ||
78 | |> [%sexp_of: eval_result] |> Sexp.output txc; | ||
79 | exit 0 | ||
80 | | `In_the_parent child_pid -> | ||
81 | let select_res = | ||
82 | Core_unix.select ~restart:true ~read:[ rxfd ] ~write:[] ~except:[] | ||
83 | ~timeout:(`After (Time_ns.Span.of_min 1.)) | ||
84 | () | ||
85 | in | ||
86 | if List.is_empty select_res.read then ( | ||
87 | ignore (Signal_unix.send Signal.kill (`Pid child_pid)); | ||
88 | ignore (Core_unix.waitpid child_pid); | ||
89 | Error `Timeout) | ||
90 | else | ||
91 | let rxc = Core_unix.in_channel_of_descr rxfd in | ||
92 | let res = Sexp.input_sexp rxc |> [%of_sexp: eval_result] in | ||
93 | ignore (Core_unix.waitpid child_pid); | ||
94 | Core_unix.close ~restart:true rxfd; | ||
95 | Core_unix.close ~restart:true txfd; | ||
96 | res | ||
97 | |||
98 | type test_result = | ||
99 | [ `Timeout | ||
100 | | `ParseError | ||
101 | | `ProgramError | ||
102 | | `ElaborateError | ||
103 | | `WrongOutput | ||
104 | | `UnexpectedSuccess | ||
105 | | `Okay ] | ||
106 | |||
107 | let run_testcase ~imports = function | ||
108 | | { name; dir; input; expected_output = `Okay expected_output } -> ( | ||
109 | match eval_subproc input ~name ~dir ~imports with | ||
110 | | Ok got_output -> | ||
111 | if String.(strip got_output = strip expected_output) then `Okay | ||
112 | else `WrongOutput | ||
113 | | Error err -> (err :> test_result)) | ||
114 | | { name; dir; input; expected_output = `Fail } -> ( | ||
115 | match eval_subproc input ~name ~dir ~imports with | ||
116 | | Ok _ -> `UnexpectedSuccess | ||
117 | | Error _ -> `Okay) | ||
118 | |||
119 | type test_stats = { | ||
120 | okay : int; | ||
121 | unexpected_success : int; | ||
122 | wrong_output : int; | ||
123 | parse_error : int; | ||
124 | elaborate_error : int; | ||
125 | program_error : int; | ||
126 | timeout : int; | ||
127 | } | ||
128 | |||
129 | let test_stats_empty = | ||
130 | { | ||
131 | okay = 0; | ||
132 | unexpected_success = 0; | ||
133 | wrong_output = 0; | ||
134 | parse_error = 0; | ||
135 | elaborate_error = 0; | ||
136 | program_error = 0; | ||
137 | timeout = 0; | ||
138 | } | ||
139 | |||
140 | let run_testcases () = | ||
141 | Nix.Printer.set_width 1000000; | ||
142 | let mat_imports = imports () in | ||
143 | let stats = | ||
144 | List.foldi !testcases ~init:test_stats_empty ~f:(fun i stats c -> | ||
145 | printf "[%d/%d] %s %!" (i + 1) (List.length !testcases) c.name; | ||
146 | match run_testcase c ~imports:mat_imports with | ||
147 | | `Okay -> | ||
148 | printf "okay\n%!"; | ||
149 | { stats with okay = stats.okay + 1 } | ||
150 | | `UnexpectedSuccess -> | ||
151 | printf "unexpectedly succeeded\n%!"; | ||
152 | { stats with unexpected_success = stats.unexpected_success + 1 } | ||
153 | | `WrongOutput -> | ||
154 | printf "gave wrong output\n%!"; | ||
155 | { stats with wrong_output = stats.wrong_output + 1 } | ||
156 | | `ParseError -> | ||
157 | printf "could not be parsed\n%!"; | ||
158 | { stats with parse_error = stats.parse_error + 1 } | ||
159 | | `ElaborateError -> | ||
160 | printf "could not be elaborated\n%!"; | ||
161 | { stats with elaborate_error = stats.elaborate_error + 1 } | ||
162 | | `ProgramError -> | ||
163 | printf "failed to execute\n%!"; | ||
164 | { stats with program_error = stats.program_error + 1 } | ||
165 | | `Timeout -> | ||
166 | printf "timed out\n%!"; | ||
167 | { stats with timeout = stats.timeout + 1 }) | ||
168 | in | ||
169 | printf | ||
170 | "Results:\n\ | ||
171 | \ %d gave the expected output\n\ | ||
172 | \ %d unexpectedly succeeded\n\ | ||
173 | \ %d gave wrong output\n\ | ||
174 | \ %d could not be parsed\n\ | ||
175 | \ %d could not be elaborated\n\ | ||
176 | \ %d failed to execute\n\ | ||
177 | \ %d timed out\n\ | ||
178 | %!" | ||
179 | stats.okay stats.unexpected_success stats.wrong_output stats.parse_error | ||
180 | stats.elaborate_error stats.program_error stats.timeout | ||
181 | |||
182 | let try_add_testcase without_ext = | ||
183 | try | ||
184 | let dir = Filename.dirname without_ext in | ||
185 | let input = In_channel.read_all (without_ext ^ ".nix") in | ||
186 | let name = Filename.basename without_ext in | ||
187 | if String.is_prefix ~prefix:"eval-fail" name then | ||
188 | add_testcase { name; dir; input; expected_output = `Fail } | ||
189 | else if String.is_prefix ~prefix:"eval-okay" name then | ||
190 | let expected_output = In_channel.read_all (without_ext ^ ".exp") in | ||
191 | add_testcase { name; dir; input; expected_output = `Okay expected_output } | ||
192 | with | ||
193 | (* There are certain test cases where the '.nix' file is available, but | ||
194 | there is no '.exp' file. (Instead, for example, there may be a | ||
195 | '.exp-disabled' file, which we don't check for.) So [add_testcase] fails | ||
196 | when trying to read the '.exp' file, which does not exist. We catch the | ||
197 | exception that is then raised in [add_testcase] here. *) | ||
198 | | Sys_error _ -> | ||
199 | () | ||
200 | |||
201 | let ignore_tests = | ||
202 | [ | ||
203 | (* We do not implement '«repeated»' *) | ||
204 | "eval-okay-repeated-empty-attrs"; | ||
205 | "eval-okay-repeated-empty-list"; | ||
206 | (* # Very specific / hard-to-implement builtins: *) | ||
207 | (* We do not implement conversion from/to JSON/XML *) | ||
208 | "eval-okay-toxml"; | ||
209 | "eval-okay-toxml2"; | ||
210 | "eval-okay-tojson"; | ||
211 | "eval-okay-fromTOML"; | ||
212 | "eval-okay-fromTOML-timestamps"; | ||
213 | "eval-okay-fromjson"; | ||
214 | "eval-okay-fromjson-escapes"; | ||
215 | "eval-fail-fromJSON-overflowing"; | ||
216 | "eval-fail-fromTOML-timestamps"; | ||
217 | "eval-fail-toJSON"; | ||
218 | (* We do not implement hasing *) | ||
219 | "eval-okay-convertHash"; | ||
220 | "eval-okay-hashstring"; | ||
221 | "eval-okay-hashfile"; | ||
222 | "eval-okay-groupBy"; | ||
223 | "eval-okay-zipAttrsWith"; | ||
224 | "eval-fail-hashfile-missing"; | ||
225 | (* We do not support filesystem operations *) | ||
226 | "eval-okay-readDir"; | ||
227 | "eval-okay-readfile"; | ||
228 | "eval-okay-readFileType"; | ||
229 | "eval-okay-symlink-resolution"; | ||
230 | (* We do not support version operations *) | ||
231 | "eval-okay-splitversion"; | ||
232 | "eval-okay-versions"; | ||
233 | (* We do not support flake references *) | ||
234 | "eval-okay-parse-flake-ref"; | ||
235 | "eval-okay-flake-ref-to-string"; | ||
236 | "eval-fail-flake-ref-to-string-negative-integer"; | ||
237 | (* We do not support regexes *) | ||
238 | "eval-okay-regex-match"; | ||
239 | "eval-okay-regex-split"; | ||
240 | (* # Features that the core interpreter lacks *) | ||
241 | (* We do not implement derivations and contexts *) | ||
242 | "eval-okay-derivation-legacy"; | ||
243 | "eval-okay-eq-derivations"; | ||
244 | "eval-fail-addDrvOutputDependencies-empty-context"; | ||
245 | "eval-fail-addDrvOutputDependencies-multi-elem-context"; | ||
246 | "eval-fail-addDrvOutputDependencies-wrong-element-kind"; | ||
247 | "eval-fail-assert-equal-derivations"; | ||
248 | "eval-fail-assert-equal-derivations-extra"; | ||
249 | "eval-fail-derivation-name"; | ||
250 | "eval-okay-context"; | ||
251 | "eval-okay-context-introspection"; | ||
252 | "eval-okay-substring-context"; | ||
253 | "eval-fail-addErrorContext-example"; | ||
254 | (* We do not support scopedImport *) | ||
255 | "eval-okay-import"; | ||
256 | (* We do not support tryEval *) | ||
257 | "eval-okay-redefine-builtin"; | ||
258 | "eval-okay-tryeval"; | ||
259 | (* We do not support unsafeGetAttrPos nor __curPos *) | ||
260 | "eval-okay-curpos"; | ||
261 | "eval-okay-getattrpos"; | ||
262 | "eval-okay-getattrpos-functionargs"; | ||
263 | "eval-okay-getattrpos-undefined"; | ||
264 | "eval-okay-inherit-attr-pos"; | ||
265 | (* We do not support environment variable lookup *) | ||
266 | "eval-okay-getenv"; | ||
267 | (* We do not support '__override's. Rationale: this construct has expressly | ||
268 | been avoided in Nixpkgs since the 13.10 release, see | ||
269 | https://github.com/NixOS/nixpkgs/issues/2112 *) | ||
270 | "eval-okay-attrs6"; | ||
271 | "eval-okay-overrides"; | ||
272 | "eval-fail-set-override"; | ||
273 | (* We do not implement the 'trace' builtin *) | ||
274 | "eval-okay-print"; | ||
275 | "eval-okay-inherit-from"; | ||
276 | (* ^ also uses __overrides, for which we lack support *) | ||
277 | (* We do not implement flags to set arguments / retrieve attributes | ||
278 | for the evaluator *) | ||
279 | (* We do not support setting variables outside of the program *) | ||
280 | "eval-okay-autoargs"; | ||
281 | (* We do not support paths *) | ||
282 | "eval-okay-baseNameOf"; | ||
283 | "eval-okay-path"; | ||
284 | "eval-okay-path-string-interpolation"; | ||
285 | "eval-okay-pathexists"; | ||
286 | "eval-okay-search-path"; | ||
287 | "eval-okay-string"; | ||
288 | "eval-okay-types"; | ||
289 | "eval-fail-assert-equal-paths"; | ||
290 | "eval-fail-bad-string-interpolation-2"; | ||
291 | "eval-fail-nonexist-path"; | ||
292 | "eval-fail-path-slash"; | ||
293 | "eval-fail-to-path"; | ||
294 | (* We do not implement the 'currentSystem' and 'dirOf' builtins *) | ||
295 | "eval-okay-builtins"; | ||
296 | (* We do not support fetch operations *) | ||
297 | "eval-fail-fetchTree-negative"; | ||
298 | "eval-fail-fetchurl-baseName"; | ||
299 | "eval-fail-fetchurl-baseName-attrs"; | ||
300 | "eval-fail-fetchurl-baseName-attrs-name"; | ||
301 | (* We do not support the pipe operator *) | ||
302 | "eval-fail-pipe-operators"; | ||
303 | ] | ||
304 | |||
305 | let () = | ||
306 | Printf.printf "Running in %s\n%!" (Core_unix.getcwd ()); | ||
307 | walk_dir testdata_dir ~f:(fun entry -> | ||
308 | match Filename.split_extension entry with | ||
309 | | without_ext, Some "nix" -> | ||
310 | if | ||
311 | List.exists ignore_tests ~f:(fun name -> | ||
312 | String.(name = Filename.basename without_ext)) | ||
313 | then testcases_ignored := !testcases_ignored + 1 | ||
314 | else try_add_testcase without_ext | ||
315 | | _ -> ()); | ||
316 | testcases := | ||
317 | List.sort !testcases ~compare:(fun c1 c2 -> String.compare c1.name c2.name); | ||
318 | print_testcase_stats (); | ||
319 | run_testcases () | ||
diff --git a/test/testdata/binary-data b/test/testdata/binary-data new file mode 100644 index 0000000..06d7405 --- /dev/null +++ b/test/testdata/binary-data | |||
Binary files differ | |||
diff --git a/test/testdata/data b/test/testdata/data new file mode 100644 index 0000000..257cc56 --- /dev/null +++ b/test/testdata/data | |||
@@ -0,0 +1 @@ | |||
foo | |||
diff --git a/test/testdata/dir1/a.nix b/test/testdata/dir1/a.nix new file mode 100644 index 0000000..231f150 --- /dev/null +++ b/test/testdata/dir1/a.nix | |||
@@ -0,0 +1 @@ | |||
"a" | |||
diff --git a/test/testdata/dir2/a.nix b/test/testdata/dir2/a.nix new file mode 100644 index 0000000..170df52 --- /dev/null +++ b/test/testdata/dir2/a.nix | |||
@@ -0,0 +1 @@ | |||
"X" | |||
diff --git a/test/testdata/dir2/b.nix b/test/testdata/dir2/b.nix new file mode 100644 index 0000000..19010cc --- /dev/null +++ b/test/testdata/dir2/b.nix | |||
@@ -0,0 +1 @@ | |||
"b" | |||
diff --git a/test/testdata/dir3/a.nix b/test/testdata/dir3/a.nix new file mode 100644 index 0000000..170df52 --- /dev/null +++ b/test/testdata/dir3/a.nix | |||
@@ -0,0 +1 @@ | |||
"X" | |||
diff --git a/test/testdata/dir3/b.nix b/test/testdata/dir3/b.nix new file mode 100644 index 0000000..170df52 --- /dev/null +++ b/test/testdata/dir3/b.nix | |||
@@ -0,0 +1 @@ | |||
"X" | |||
diff --git a/test/testdata/dir3/c.nix b/test/testdata/dir3/c.nix new file mode 100644 index 0000000..cdf1585 --- /dev/null +++ b/test/testdata/dir3/c.nix | |||
@@ -0,0 +1 @@ | |||
"c" | |||
diff --git a/test/testdata/dir4/a.nix b/test/testdata/dir4/a.nix new file mode 100644 index 0000000..170df52 --- /dev/null +++ b/test/testdata/dir4/a.nix | |||
@@ -0,0 +1 @@ | |||
"X" | |||
diff --git a/test/testdata/dir4/c.nix b/test/testdata/dir4/c.nix new file mode 100644 index 0000000..170df52 --- /dev/null +++ b/test/testdata/dir4/c.nix | |||
@@ -0,0 +1 @@ | |||
"X" | |||
diff --git a/test/testdata/eval-fail-abort.err.exp b/test/testdata/eval-fail-abort.err.exp new file mode 100644 index 0000000..20e7b9e --- /dev/null +++ b/test/testdata/eval-fail-abort.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while calling the 'abort' builtin | ||
3 | at /pwd/lang/eval-fail-abort.nix:1:14: | ||
4 | 1| if true then abort "this should fail" else 1 | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: evaluation aborted with the following error message: 'this should fail' | ||
diff --git a/test/testdata/eval-fail-abort.nix b/test/testdata/eval-fail-abort.nix new file mode 100644 index 0000000..75c51bc --- /dev/null +++ b/test/testdata/eval-fail-abort.nix | |||
@@ -0,0 +1 @@ | |||
if true then abort "this should fail" else 1 | |||
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.err.exp b/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.err.exp new file mode 100644 index 0000000..37e0bd9 --- /dev/null +++ b/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while calling the 'addDrvOutputDependencies' builtin | ||
3 | at /pwd/lang/eval-fail-addDrvOutputDependencies-empty-context.nix:1:1: | ||
4 | 1| builtins.addDrvOutputDependencies "" | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: context of string '' must have exactly one element, but has 0 | ||
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.nix b/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.nix new file mode 100644 index 0000000..dc9ee3b --- /dev/null +++ b/test/testdata/eval-fail-addDrvOutputDependencies-empty-context.nix | |||
@@ -0,0 +1 @@ | |||
builtins.addDrvOutputDependencies "" | |||
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.err.exp b/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.err.exp new file mode 100644 index 0000000..6828e03 --- /dev/null +++ b/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.err.exp | |||
@@ -0,0 +1,9 @@ | |||
1 | error: | ||
2 | … while calling the 'addDrvOutputDependencies' builtin | ||
3 | at /pwd/lang/eval-fail-addDrvOutputDependencies-multi-elem-context.nix:18:4: | ||
4 | 17| | ||
5 | 18| in builtins.addDrvOutputDependencies combo-path | ||
6 | | ^ | ||
7 | 19| | ||
8 | |||
9 | error: context of string '/nix/store/pg9yqs4yd85yhdm3f4i5dyaqp5jahrsz-fail.drv/nix/store/2dxd5frb715z451vbf7s8birlf3argbk-fail-2.drv' must have exactly one element, but has 2 | ||
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.nix b/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.nix new file mode 100644 index 0000000..dbde264 --- /dev/null +++ b/test/testdata/eval-fail-addDrvOutputDependencies-multi-elem-context.nix | |||
@@ -0,0 +1,18 @@ | |||
1 | let | ||
2 | drv0 = derivation { | ||
3 | name = "fail"; | ||
4 | builder = "/bin/false"; | ||
5 | system = "x86_64-linux"; | ||
6 | outputs = [ "out" "foo" ]; | ||
7 | }; | ||
8 | |||
9 | drv1 = derivation { | ||
10 | name = "fail-2"; | ||
11 | builder = "/bin/false"; | ||
12 | system = "x86_64-linux"; | ||
13 | outputs = [ "out" "foo" ]; | ||
14 | }; | ||
15 | |||
16 | combo-path = "${drv0.drvPath}${drv1.drvPath}"; | ||
17 | |||
18 | in builtins.addDrvOutputDependencies combo-path | ||
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.err.exp b/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.err.exp new file mode 100644 index 0000000..72b5e63 --- /dev/null +++ b/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.err.exp | |||
@@ -0,0 +1,9 @@ | |||
1 | error: | ||
2 | … while calling the 'addDrvOutputDependencies' builtin | ||
3 | at /pwd/lang/eval-fail-addDrvOutputDependencies-wrong-element-kind.nix:9:4: | ||
4 | 8| | ||
5 | 9| in builtins.addDrvOutputDependencies drv.outPath | ||
6 | | ^ | ||
7 | 10| | ||
8 | |||
9 | error: `addDrvOutputDependencies` can only act on derivations, not on a derivation output such as 'out' | ||
diff --git a/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.nix b/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.nix new file mode 100644 index 0000000..e379e1d --- /dev/null +++ b/test/testdata/eval-fail-addDrvOutputDependencies-wrong-element-kind.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | let | ||
2 | drv = derivation { | ||
3 | name = "fail"; | ||
4 | builder = "/bin/false"; | ||
5 | system = "x86_64-linux"; | ||
6 | outputs = [ "out" "foo" ]; | ||
7 | }; | ||
8 | |||
9 | in builtins.addDrvOutputDependencies drv.outPath | ||
diff --git a/test/testdata/eval-fail-addErrorContext-example.err.exp b/test/testdata/eval-fail-addErrorContext-example.err.exp new file mode 100644 index 0000000..4fad8f5 --- /dev/null +++ b/test/testdata/eval-fail-addErrorContext-example.err.exp | |||
@@ -0,0 +1,24 @@ | |||
1 | error: | ||
2 | … while counting down; n = 10 | ||
3 | |||
4 | … while counting down; n = 9 | ||
5 | |||
6 | … while counting down; n = 8 | ||
7 | |||
8 | … while counting down; n = 7 | ||
9 | |||
10 | … while counting down; n = 6 | ||
11 | |||
12 | … while counting down; n = 5 | ||
13 | |||
14 | … while counting down; n = 4 | ||
15 | |||
16 | … while counting down; n = 3 | ||
17 | |||
18 | … while counting down; n = 2 | ||
19 | |||
20 | … while counting down; n = 1 | ||
21 | |||
22 | (stack trace truncated; use '--show-trace' to show the full, detailed trace) | ||
23 | |||
24 | error: kaboom | ||
diff --git a/test/testdata/eval-fail-addErrorContext-example.flags b/test/testdata/eval-fail-addErrorContext-example.flags new file mode 100644 index 0000000..9b1f645 --- /dev/null +++ b/test/testdata/eval-fail-addErrorContext-example.flags | |||
@@ -0,0 +1 @@ | |||
--eval --strict --no-show-trace | |||
diff --git a/test/testdata/eval-fail-addErrorContext-example.nix b/test/testdata/eval-fail-addErrorContext-example.nix new file mode 100644 index 0000000..996b246 --- /dev/null +++ b/test/testdata/eval-fail-addErrorContext-example.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | let | ||
2 | countDown = n: | ||
3 | if n == 0 | ||
4 | then throw "kaboom" | ||
5 | else | ||
6 | builtins.addErrorContext | ||
7 | "while counting down; n = ${toString n}" | ||
8 | ("x" + countDown (n - 1)); | ||
9 | in countDown 10 | ||
diff --git a/test/testdata/eval-fail-assert-equal-attrs-names-2.err.exp b/test/testdata/eval-fail-assert-equal-attrs-names-2.err.exp new file mode 100644 index 0000000..4b68d97 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-attrs-names-2.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '({ a = true; } == { a = true; b = true; })' | ||
3 | at /pwd/lang/eval-fail-assert-equal-attrs-names-2.nix:1:1: | ||
4 | 1| assert { a = true; } == { a = true; b = true; }; | ||
5 | | ^ | ||
6 | 2| throw "unreachable" | ||
7 | |||
8 | error: attribute names of attribute set '{ a = true; }' differs from attribute set '{ a = true; b = true; }' | ||
diff --git a/test/testdata/eval-fail-assert-equal-attrs-names-2.nix b/test/testdata/eval-fail-assert-equal-attrs-names-2.nix new file mode 100644 index 0000000..8e7ac9c --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-attrs-names-2.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | assert { a = true; } == { a = true; b = true; }; | ||
2 | throw "unreachable" | ||
diff --git a/test/testdata/eval-fail-assert-equal-attrs-names.err.exp b/test/testdata/eval-fail-assert-equal-attrs-names.err.exp new file mode 100644 index 0000000..bc61ca6 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-attrs-names.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '({ a = true; b = true; } == { a = true; })' | ||
3 | at /pwd/lang/eval-fail-assert-equal-attrs-names.nix:1:1: | ||
4 | 1| assert { a = true; b = true; } == { a = true; }; | ||
5 | | ^ | ||
6 | 2| throw "unreachable" | ||
7 | |||
8 | error: attribute names of attribute set '{ a = true; b = true; }' differs from attribute set '{ a = true; }' | ||
diff --git a/test/testdata/eval-fail-assert-equal-attrs-names.nix b/test/testdata/eval-fail-assert-equal-attrs-names.nix new file mode 100644 index 0000000..e2f53a8 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-attrs-names.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | assert { a = true; b = true; } == { a = true; }; | ||
2 | throw "unreachable" | ||
diff --git a/test/testdata/eval-fail-assert-equal-derivations-extra.err.exp b/test/testdata/eval-fail-assert-equal-derivations-extra.err.exp new file mode 100644 index 0000000..7f49240 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-derivations-extra.err.exp | |||
@@ -0,0 +1,26 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '({ foo = { outPath = "/nix/store/0"; type = "derivation"; }; } == { foo = { devious = true; outPath = "/nix/store/1"; type = "derivation"; }; })' | ||
3 | at /pwd/lang/eval-fail-assert-equal-derivations-extra.nix:1:1: | ||
4 | 1| assert | ||
5 | | ^ | ||
6 | 2| { foo = { type = "derivation"; outPath = "/nix/store/0"; }; } | ||
7 | |||
8 | … while comparing attribute 'foo' | ||
9 | |||
10 | … where left hand side is | ||
11 | at /pwd/lang/eval-fail-assert-equal-derivations-extra.nix:2:5: | ||
12 | 1| assert | ||
13 | 2| { foo = { type = "derivation"; outPath = "/nix/store/0"; }; } | ||
14 | | ^ | ||
15 | 3| == | ||
16 | |||
17 | … where right hand side is | ||
18 | at /pwd/lang/eval-fail-assert-equal-derivations-extra.nix:4:5: | ||
19 | 3| == | ||
20 | 4| { foo = { type = "derivation"; outPath = "/nix/store/1"; devious = true; }; }; | ||
21 | | ^ | ||
22 | 5| throw "unreachable" | ||
23 | |||
24 | … while comparing a derivation by its 'outPath' attribute | ||
25 | |||
26 | error: string '"/nix/store/0"' is not equal to string '"/nix/store/1"' | ||
diff --git a/test/testdata/eval-fail-assert-equal-derivations-extra.nix b/test/testdata/eval-fail-assert-equal-derivations-extra.nix new file mode 100644 index 0000000..fd8bc3f --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-derivations-extra.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | assert | ||
2 | { foo = { type = "derivation"; outPath = "/nix/store/0"; }; } | ||
3 | == | ||
4 | { foo = { type = "derivation"; outPath = "/nix/store/1"; devious = true; }; }; | ||
5 | throw "unreachable" \ No newline at end of file | ||
diff --git a/test/testdata/eval-fail-assert-equal-derivations.err.exp b/test/testdata/eval-fail-assert-equal-derivations.err.exp new file mode 100644 index 0000000..d7f0fac --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-derivations.err.exp | |||
@@ -0,0 +1,26 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '({ foo = { ignored = (abort "not ignored"); outPath = "/nix/store/0"; type = "derivation"; }; } == { foo = { ignored = (abort "not ignored"); outPath = "/nix/store/1"; type = "derivation"; }; })' | ||
3 | at /pwd/lang/eval-fail-assert-equal-derivations.nix:1:1: | ||
4 | 1| assert | ||
5 | | ^ | ||
6 | 2| { foo = { type = "derivation"; outPath = "/nix/store/0"; ignored = abort "not ignored"; }; } | ||
7 | |||
8 | … while comparing attribute 'foo' | ||
9 | |||
10 | … where left hand side is | ||
11 | at /pwd/lang/eval-fail-assert-equal-derivations.nix:2:5: | ||
12 | 1| assert | ||
13 | 2| { foo = { type = "derivation"; outPath = "/nix/store/0"; ignored = abort "not ignored"; }; } | ||
14 | | ^ | ||
15 | 3| == | ||
16 | |||
17 | … where right hand side is | ||
18 | at /pwd/lang/eval-fail-assert-equal-derivations.nix:4:5: | ||
19 | 3| == | ||
20 | 4| { foo = { type = "derivation"; outPath = "/nix/store/1"; ignored = abort "not ignored"; }; }; | ||
21 | | ^ | ||
22 | 5| throw "unreachable" | ||
23 | |||
24 | … while comparing a derivation by its 'outPath' attribute | ||
25 | |||
26 | error: string '"/nix/store/0"' is not equal to string '"/nix/store/1"' | ||
diff --git a/test/testdata/eval-fail-assert-equal-derivations.nix b/test/testdata/eval-fail-assert-equal-derivations.nix new file mode 100644 index 0000000..c648eae --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-derivations.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | assert | ||
2 | { foo = { type = "derivation"; outPath = "/nix/store/0"; ignored = abort "not ignored"; }; } | ||
3 | == | ||
4 | { foo = { type = "derivation"; outPath = "/nix/store/1"; ignored = abort "not ignored"; }; }; | ||
5 | throw "unreachable" \ No newline at end of file | ||
diff --git a/test/testdata/eval-fail-assert-equal-floats.err.exp b/test/testdata/eval-fail-assert-equal-floats.err.exp new file mode 100644 index 0000000..d8545e2 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-floats.err.exp | |||
@@ -0,0 +1,22 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '({ b = 1; } == { b = 1.01; })' | ||
3 | at /pwd/lang/eval-fail-assert-equal-floats.nix:1:1: | ||
4 | 1| assert { b = 1.0; } == { b = 1.01; }; | ||
5 | | ^ | ||
6 | 2| abort "unreachable" | ||
7 | |||
8 | … while comparing attribute 'b' | ||
9 | |||
10 | … where left hand side is | ||
11 | at /pwd/lang/eval-fail-assert-equal-floats.nix:1:10: | ||
12 | 1| assert { b = 1.0; } == { b = 1.01; }; | ||
13 | | ^ | ||
14 | 2| abort "unreachable" | ||
15 | |||
16 | … where right hand side is | ||
17 | at /pwd/lang/eval-fail-assert-equal-floats.nix:1:26: | ||
18 | 1| assert { b = 1.0; } == { b = 1.01; }; | ||
19 | | ^ | ||
20 | 2| abort "unreachable" | ||
21 | |||
22 | error: a float with value '1' is not equal to a float with value '1.01' | ||
diff --git a/test/testdata/eval-fail-assert-equal-floats.nix b/test/testdata/eval-fail-assert-equal-floats.nix new file mode 100644 index 0000000..438e85a --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-floats.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | assert { b = 1.0; } == { b = 1.01; }; | ||
2 | abort "unreachable" | ||
diff --git a/test/testdata/eval-fail-assert-equal-function-direct.err.exp b/test/testdata/eval-fail-assert-equal-function-direct.err.exp new file mode 100644 index 0000000..f06d796 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-function-direct.err.exp | |||
@@ -0,0 +1,9 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '((x: x) == (x: x))' | ||
3 | at /pwd/lang/eval-fail-assert-equal-function-direct.nix:3:1: | ||
4 | 2| # This only compares a direct comparison and makes no claims about functions in nested structures. | ||
5 | 3| assert | ||
6 | | ^ | ||
7 | 4| (x: x) | ||
8 | |||
9 | error: distinct functions and immediate comparisons of identical functions compare as unequal | ||
diff --git a/test/testdata/eval-fail-assert-equal-function-direct.nix b/test/testdata/eval-fail-assert-equal-function-direct.nix new file mode 100644 index 0000000..68e5e39 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-function-direct.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | # Note: functions in nested structures, e.g. attributes, may be optimized away by pointer identity optimization. | ||
2 | # This only compares a direct comparison and makes no claims about functions in nested structures. | ||
3 | assert | ||
4 | (x: x) | ||
5 | == | ||
6 | (x: x); | ||
7 | abort "unreachable" \ No newline at end of file | ||
diff --git a/test/testdata/eval-fail-assert-equal-int-float.err.exp b/test/testdata/eval-fail-assert-equal-int-float.err.exp new file mode 100644 index 0000000..c927e38 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-int-float.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '(1 == 1.1)' | ||
3 | at /pwd/lang/eval-fail-assert-equal-int-float.nix:1:1: | ||
4 | 1| assert 1 == 1.1; | ||
5 | | ^ | ||
6 | 2| throw "unreachable" | ||
7 | |||
8 | error: an integer with value '1' is not equal to a float with value '1.1' | ||
diff --git a/test/testdata/eval-fail-assert-equal-int-float.nix b/test/testdata/eval-fail-assert-equal-int-float.nix new file mode 100644 index 0000000..1dfdf2b --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-int-float.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | assert 1 == 1.1; | ||
2 | throw "unreachable" | ||
diff --git a/test/testdata/eval-fail-assert-equal-ints.err.exp b/test/testdata/eval-fail-assert-equal-ints.err.exp new file mode 100644 index 0000000..d6219e2 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-ints.err.exp | |||
@@ -0,0 +1,22 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '({ b = 1; } == { b = 2; })' | ||
3 | at /pwd/lang/eval-fail-assert-equal-ints.nix:1:1: | ||
4 | 1| assert { b = 1; } == { b = 2; }; | ||
5 | | ^ | ||
6 | 2| abort "unreachable" | ||
7 | |||
8 | … while comparing attribute 'b' | ||
9 | |||
10 | … where left hand side is | ||
11 | at /pwd/lang/eval-fail-assert-equal-ints.nix:1:10: | ||
12 | 1| assert { b = 1; } == { b = 2; }; | ||
13 | | ^ | ||
14 | 2| abort "unreachable" | ||
15 | |||
16 | … where right hand side is | ||
17 | at /pwd/lang/eval-fail-assert-equal-ints.nix:1:24: | ||
18 | 1| assert { b = 1; } == { b = 2; }; | ||
19 | | ^ | ||
20 | 2| abort "unreachable" | ||
21 | |||
22 | error: an integer with value '1' is not equal to an integer with value '2' | ||
diff --git a/test/testdata/eval-fail-assert-equal-ints.nix b/test/testdata/eval-fail-assert-equal-ints.nix new file mode 100644 index 0000000..645258e --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-ints.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | assert { b = 1; } == { b = 2; }; | ||
2 | abort "unreachable" | ||
diff --git a/test/testdata/eval-fail-assert-equal-list-length.err.exp b/test/testdata/eval-fail-assert-equal-list-length.err.exp new file mode 100644 index 0000000..9010855 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-list-length.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '([ (1) (0) ] == [ (10) ])' | ||
3 | at /pwd/lang/eval-fail-assert-equal-list-length.nix:1:1: | ||
4 | 1| assert [ 1 0 ] == [ 10 ]; | ||
5 | | ^ | ||
6 | 2| throw "unreachable" | ||
7 | |||
8 | error: list of size '2' is not equal to list of size '1', left hand side is '[ 1 0 ]', right hand side is '[ 10 ]' | ||
diff --git a/test/testdata/eval-fail-assert-equal-list-length.nix b/test/testdata/eval-fail-assert-equal-list-length.nix new file mode 100644 index 0000000..6d40f4d --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-list-length.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | assert [ 1 0 ] == [ 10 ]; | ||
2 | throw "unreachable" \ No newline at end of file | ||
diff --git a/test/testdata/eval-fail-assert-equal-paths.err.exp b/test/testdata/eval-fail-assert-equal-paths.err.exp new file mode 100644 index 0000000..66c34e9 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-paths.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '(/pwd/lang/foo == /pwd/lang/bar)' | ||
3 | at /pwd/lang/eval-fail-assert-equal-paths.nix:1:1: | ||
4 | 1| assert ./foo == ./bar; | ||
5 | | ^ | ||
6 | 2| throw "unreachable" | ||
7 | |||
8 | error: path '/pwd/lang/foo' is not equal to path '/pwd/lang/bar' | ||
diff --git a/test/testdata/eval-fail-assert-equal-paths.nix b/test/testdata/eval-fail-assert-equal-paths.nix new file mode 100644 index 0000000..ef0b670 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-paths.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | assert ./foo == ./bar; | ||
2 | throw "unreachable" \ No newline at end of file | ||
diff --git a/test/testdata/eval-fail-assert-equal-type-nested.err.exp b/test/testdata/eval-fail-assert-equal-type-nested.err.exp new file mode 100644 index 0000000..f78badd --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-type-nested.err.exp | |||
@@ -0,0 +1,22 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '({ ding = false; } == { ding = null; })' | ||
3 | at /pwd/lang/eval-fail-assert-equal-type-nested.nix:1:1: | ||
4 | 1| assert { ding = false; } == { ding = null; }; | ||
5 | | ^ | ||
6 | 2| abort "unreachable" | ||
7 | |||
8 | … while comparing attribute 'ding' | ||
9 | |||
10 | … where left hand side is | ||
11 | at /pwd/lang/eval-fail-assert-equal-type-nested.nix:1:10: | ||
12 | 1| assert { ding = false; } == { ding = null; }; | ||
13 | | ^ | ||
14 | 2| abort "unreachable" | ||
15 | |||
16 | … where right hand side is | ||
17 | at /pwd/lang/eval-fail-assert-equal-type-nested.nix:1:31: | ||
18 | 1| assert { ding = false; } == { ding = null; }; | ||
19 | | ^ | ||
20 | 2| abort "unreachable" | ||
21 | |||
22 | error: a Boolean of value 'false' is not equal to null of value 'null' | ||
diff --git a/test/testdata/eval-fail-assert-equal-type-nested.nix b/test/testdata/eval-fail-assert-equal-type-nested.nix new file mode 100644 index 0000000..3fbd14c --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-type-nested.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | assert { ding = false; } == { ding = null; }; | ||
2 | abort "unreachable" | ||
diff --git a/test/testdata/eval-fail-assert-equal-type.err.exp b/test/testdata/eval-fail-assert-equal-type.err.exp new file mode 100644 index 0000000..4dc3f2e --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-type.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '(false == null)' | ||
3 | at /pwd/lang/eval-fail-assert-equal-type.nix:1:1: | ||
4 | 1| assert false == null; | ||
5 | | ^ | ||
6 | 2| abort "unreachable" | ||
7 | |||
8 | error: a Boolean of value 'false' is not equal to null of value 'null' | ||
diff --git a/test/testdata/eval-fail-assert-equal-type.nix b/test/testdata/eval-fail-assert-equal-type.nix new file mode 100644 index 0000000..7023ea0 --- /dev/null +++ b/test/testdata/eval-fail-assert-equal-type.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | assert false == null; | ||
2 | abort "unreachable" | ||
diff --git a/test/testdata/eval-fail-assert-nested-bool.err.exp b/test/testdata/eval-fail-assert-nested-bool.err.exp new file mode 100644 index 0000000..1debb66 --- /dev/null +++ b/test/testdata/eval-fail-assert-nested-bool.err.exp | |||
@@ -0,0 +1,74 @@ | |||
1 | error: | ||
2 | … while evaluating the condition of the assertion '({ a = { b = [ ({ c = { d = true; }; }) ]; }; } == { a = { b = [ ({ c = { d = false; }; }) ]; }; })' | ||
3 | at /pwd/lang/eval-fail-assert-nested-bool.nix:1:1: | ||
4 | 1| assert | ||
5 | | ^ | ||
6 | 2| { a.b = [ { c.d = true; } ]; } | ||
7 | |||
8 | … while comparing attribute 'a' | ||
9 | |||
10 | … where left hand side is | ||
11 | at /pwd/lang/eval-fail-assert-nested-bool.nix:2:5: | ||
12 | 1| assert | ||
13 | 2| { a.b = [ { c.d = true; } ]; } | ||
14 | | ^ | ||
15 | 3| == | ||
16 | |||
17 | … where right hand side is | ||
18 | at /pwd/lang/eval-fail-assert-nested-bool.nix:4:5: | ||
19 | 3| == | ||
20 | 4| { a.b = [ { c.d = false; } ]; }; | ||
21 | | ^ | ||
22 | 5| | ||
23 | |||
24 | … while comparing attribute 'b' | ||
25 | |||
26 | … where left hand side is | ||
27 | at /pwd/lang/eval-fail-assert-nested-bool.nix:2:5: | ||
28 | 1| assert | ||
29 | 2| { a.b = [ { c.d = true; } ]; } | ||
30 | | ^ | ||
31 | 3| == | ||
32 | |||
33 | … where right hand side is | ||
34 | at /pwd/lang/eval-fail-assert-nested-bool.nix:4:5: | ||
35 | 3| == | ||
36 | 4| { a.b = [ { c.d = false; } ]; }; | ||
37 | | ^ | ||
38 | 5| | ||
39 | |||
40 | … while comparing list element 0 | ||
41 | |||
42 | … while comparing attribute 'c' | ||
43 | |||
44 | … where left hand side is | ||
45 | at /pwd/lang/eval-fail-assert-nested-bool.nix:2:15: | ||
46 | 1| assert | ||
47 | 2| { a.b = [ { c.d = true; } ]; } | ||
48 | | ^ | ||
49 | 3| == | ||
50 | |||
51 | … where right hand side is | ||
52 | at /pwd/lang/eval-fail-assert-nested-bool.nix:4:15: | ||
53 | 3| == | ||
54 | 4| { a.b = [ { c.d = false; } ]; }; | ||
55 | | ^ | ||
56 | 5| | ||
57 | |||
58 | … while comparing attribute 'd' | ||
59 | |||
60 | … where left hand side is | ||
61 | at /pwd/lang/eval-fail-assert-nested-bool.nix:2:15: | ||
62 | 1| assert | ||
63 | 2| { a.b = [ { c.d = true; } ]; } | ||
64 | | ^ | ||
65 | 3| == | ||
66 | |||
67 | … where right hand side is | ||
68 | at /pwd/lang/eval-fail-assert-nested-bool.nix:4:15: | ||
69 | 3| == | ||
70 | 4| { a.b = [ { c.d = false; } ]; }; | ||
71 | | ^ | ||
72 | 5| | ||
73 | |||
74 | error: boolean 'true' is not equal to boolean 'false' | ||
diff --git a/test/testdata/eval-fail-assert-nested-bool.nix b/test/testdata/eval-fail-assert-nested-bool.nix new file mode 100644 index 0000000..2285769 --- /dev/null +++ b/test/testdata/eval-fail-assert-nested-bool.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | assert | ||
2 | { a.b = [ { c.d = true; } ]; } | ||
3 | == | ||
4 | { a.b = [ { c.d = false; } ]; }; | ||
5 | |||
6 | abort "unreachable" \ No newline at end of file | ||
diff --git a/test/testdata/eval-fail-assert.err.exp b/test/testdata/eval-fail-assert.err.exp new file mode 100644 index 0000000..7be9e23 --- /dev/null +++ b/test/testdata/eval-fail-assert.err.exp | |||
@@ -0,0 +1,30 @@ | |||
1 | error: | ||
2 | … while evaluating the attribute 'body' | ||
3 | at /pwd/lang/eval-fail-assert.nix:4:3: | ||
4 | 3| | ||
5 | 4| body = x "x"; | ||
6 | | ^ | ||
7 | 5| } | ||
8 | |||
9 | … from call site | ||
10 | at /pwd/lang/eval-fail-assert.nix:4:10: | ||
11 | 3| | ||
12 | 4| body = x "x"; | ||
13 | | ^ | ||
14 | 5| } | ||
15 | |||
16 | … while calling 'x' | ||
17 | at /pwd/lang/eval-fail-assert.nix:2:7: | ||
18 | 1| let { | ||
19 | 2| x = arg: assert arg == "y"; 123; | ||
20 | | ^ | ||
21 | 3| | ||
22 | |||
23 | … while evaluating the condition of the assertion '(arg == "y")' | ||
24 | at /pwd/lang/eval-fail-assert.nix:2:12: | ||
25 | 1| let { | ||
26 | 2| x = arg: assert arg == "y"; 123; | ||
27 | | ^ | ||
28 | 3| | ||
29 | |||
30 | error: string '"x"' is not equal to string '"y"' | ||
diff --git a/test/testdata/eval-fail-assert.nix b/test/testdata/eval-fail-assert.nix new file mode 100644 index 0000000..3b7a1e8 --- /dev/null +++ b/test/testdata/eval-fail-assert.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | let { | ||
2 | x = arg: assert arg == "y"; 123; | ||
3 | |||
4 | body = x "x"; | ||
5 | } \ No newline at end of file | ||
diff --git a/test/testdata/eval-fail-attr-name-type.err.exp b/test/testdata/eval-fail-attr-name-type.err.exp new file mode 100644 index 0000000..6848a35 --- /dev/null +++ b/test/testdata/eval-fail-attr-name-type.err.exp | |||
@@ -0,0 +1,21 @@ | |||
1 | error: | ||
2 | … while evaluating the attribute 'puppy."${key}"' | ||
3 | at /pwd/lang/eval-fail-attr-name-type.nix:3:5: | ||
4 | 2| attrs = { | ||
5 | 3| puppy.doggy = {}; | ||
6 | | ^ | ||
7 | 4| }; | ||
8 | |||
9 | … while evaluating an attribute name | ||
10 | at /pwd/lang/eval-fail-attr-name-type.nix:7:17: | ||
11 | 6| in | ||
12 | 7| attrs.puppy.${key} | ||
13 | | ^ | ||
14 | 8| | ||
15 | |||
16 | error: expected a string but found an integer: 1 | ||
17 | at /pwd/lang/eval-fail-attr-name-type.nix:7:17: | ||
18 | 6| in | ||
19 | 7| attrs.puppy.${key} | ||
20 | | ^ | ||
21 | 8| | ||
diff --git a/test/testdata/eval-fail-attr-name-type.nix b/test/testdata/eval-fail-attr-name-type.nix new file mode 100644 index 0000000..a0e7600 --- /dev/null +++ b/test/testdata/eval-fail-attr-name-type.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | let | ||
2 | attrs = { | ||
3 | puppy.doggy = {}; | ||
4 | }; | ||
5 | key = 1; | ||
6 | in | ||
7 | attrs.puppy.${key} | ||
diff --git a/test/testdata/eval-fail-bad-string-interpolation-1.err.exp b/test/testdata/eval-fail-bad-string-interpolation-1.err.exp new file mode 100644 index 0000000..5ae5303 --- /dev/null +++ b/test/testdata/eval-fail-bad-string-interpolation-1.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while evaluating a path segment | ||
3 | at /pwd/lang/eval-fail-bad-string-interpolation-1.nix:1:2: | ||
4 | 1| "${x: x}" | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: cannot coerce a function to a string: «lambda @ /pwd/lang/eval-fail-bad-string-interpolation-1.nix:1:4» | ||
diff --git a/test/testdata/eval-fail-bad-string-interpolation-1.nix b/test/testdata/eval-fail-bad-string-interpolation-1.nix new file mode 100644 index 0000000..ffe9c98 --- /dev/null +++ b/test/testdata/eval-fail-bad-string-interpolation-1.nix | |||
@@ -0,0 +1 @@ | |||
"${x: x}" | |||
diff --git a/test/testdata/eval-fail-bad-string-interpolation-2.err.exp b/test/testdata/eval-fail-bad-string-interpolation-2.err.exp new file mode 100644 index 0000000..a287067 --- /dev/null +++ b/test/testdata/eval-fail-bad-string-interpolation-2.err.exp | |||
@@ -0,0 +1 @@ | |||
error: path '/pwd/lang/fnord' does not exist | |||
diff --git a/test/testdata/eval-fail-bad-string-interpolation-2.nix b/test/testdata/eval-fail-bad-string-interpolation-2.nix new file mode 100644 index 0000000..3745235 --- /dev/null +++ b/test/testdata/eval-fail-bad-string-interpolation-2.nix | |||
@@ -0,0 +1 @@ | |||
"${./fnord}" | |||
diff --git a/test/testdata/eval-fail-bad-string-interpolation-3.err.exp b/test/testdata/eval-fail-bad-string-interpolation-3.err.exp new file mode 100644 index 0000000..170a3d1 --- /dev/null +++ b/test/testdata/eval-fail-bad-string-interpolation-3.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while evaluating a path segment | ||
3 | at /pwd/lang/eval-fail-bad-string-interpolation-3.nix:1:3: | ||
4 | 1| ''${x: x}'' | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: cannot coerce a function to a string: «lambda @ /pwd/lang/eval-fail-bad-string-interpolation-3.nix:1:5» | ||
diff --git a/test/testdata/eval-fail-bad-string-interpolation-3.nix b/test/testdata/eval-fail-bad-string-interpolation-3.nix new file mode 100644 index 0000000..65b9d4f --- /dev/null +++ b/test/testdata/eval-fail-bad-string-interpolation-3.nix | |||
@@ -0,0 +1 @@ | |||
''${x: x}'' | |||
diff --git a/test/testdata/eval-fail-bad-string-interpolation-4.err.exp b/test/testdata/eval-fail-bad-string-interpolation-4.err.exp new file mode 100644 index 0000000..b262e81 --- /dev/null +++ b/test/testdata/eval-fail-bad-string-interpolation-4.err.exp | |||
@@ -0,0 +1,9 @@ | |||
1 | error: | ||
2 | … while evaluating a path segment | ||
3 | at /pwd/lang/eval-fail-bad-string-interpolation-4.nix:9:3: | ||
4 | 8| # The error message should not be too long. | ||
5 | 9| ''${pkgs}'' | ||
6 | | ^ | ||
7 | 10| | ||
8 | |||
9 | error: cannot coerce a set to a string: { a = { a = { a = { a = "ha"; b = "ha"; c = "ha"; d = "ha"; e = "ha"; f = "ha"; g = "ha"; h = "ha"; j = "ha"; }; «8 attributes elided» }; «8 attributes elided» }; «8 attributes elided» } | ||
diff --git a/test/testdata/eval-fail-bad-string-interpolation-4.nix b/test/testdata/eval-fail-bad-string-interpolation-4.nix new file mode 100644 index 0000000..457b5f0 --- /dev/null +++ b/test/testdata/eval-fail-bad-string-interpolation-4.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | let | ||
2 | # Basically a "billion laughs" attack, but toned down to simulated `pkgs`. | ||
3 | ha = x: y: { a = x y; b = x y; c = x y; d = x y; e = x y; f = x y; g = x y; h = x y; j = x y; }; | ||
4 | has = ha (ha (ha (ha (x: x)))) "ha"; | ||
5 | # A large structure that has already been evaluated. | ||
6 | pkgs = builtins.deepSeq has has; | ||
7 | in | ||
8 | # The error message should not be too long. | ||
9 | ''${pkgs}'' | ||
diff --git a/test/testdata/eval-fail-blackhole.err.exp b/test/testdata/eval-fail-blackhole.err.exp new file mode 100644 index 0000000..95e33a5 --- /dev/null +++ b/test/testdata/eval-fail-blackhole.err.exp | |||
@@ -0,0 +1,14 @@ | |||
1 | error: | ||
2 | … while evaluating the attribute 'body' | ||
3 | at /pwd/lang/eval-fail-blackhole.nix:2:3: | ||
4 | 1| let { | ||
5 | 2| body = x; | ||
6 | | ^ | ||
7 | 3| x = y; | ||
8 | |||
9 | error: infinite recursion encountered | ||
10 | at /pwd/lang/eval-fail-blackhole.nix:3:7: | ||
11 | 2| body = x; | ||
12 | 3| x = y; | ||
13 | | ^ | ||
14 | 4| y = x; | ||
diff --git a/test/testdata/eval-fail-blackhole.nix b/test/testdata/eval-fail-blackhole.nix new file mode 100644 index 0000000..81133b5 --- /dev/null +++ b/test/testdata/eval-fail-blackhole.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | let { | ||
2 | body = x; | ||
3 | x = y; | ||
4 | y = x; | ||
5 | } | ||
diff --git a/test/testdata/eval-fail-call-primop.err.exp b/test/testdata/eval-fail-call-primop.err.exp new file mode 100644 index 0000000..0c6f614 --- /dev/null +++ b/test/testdata/eval-fail-call-primop.err.exp | |||
@@ -0,0 +1,10 @@ | |||
1 | error: | ||
2 | … while calling the 'length' builtin | ||
3 | at /pwd/lang/eval-fail-call-primop.nix:1:1: | ||
4 | 1| builtins.length 1 | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | … while evaluating the first argument passed to builtins.length | ||
9 | |||
10 | error: expected a list but found an integer: 1 | ||
diff --git a/test/testdata/eval-fail-call-primop.nix b/test/testdata/eval-fail-call-primop.nix new file mode 100644 index 0000000..972eb72 --- /dev/null +++ b/test/testdata/eval-fail-call-primop.nix | |||
@@ -0,0 +1 @@ | |||
builtins.length 1 | |||
diff --git a/test/testdata/eval-fail-deepseq.err.exp b/test/testdata/eval-fail-deepseq.err.exp new file mode 100644 index 0000000..11b6234 --- /dev/null +++ b/test/testdata/eval-fail-deepseq.err.exp | |||
@@ -0,0 +1,20 @@ | |||
1 | error: | ||
2 | … while calling the 'deepSeq' builtin | ||
3 | at /pwd/lang/eval-fail-deepseq.nix:1:1: | ||
4 | 1| builtins.deepSeq { x = abort "foo"; } 456 | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | … while evaluating the attribute 'x' | ||
9 | at /pwd/lang/eval-fail-deepseq.nix:1:20: | ||
10 | 1| builtins.deepSeq { x = abort "foo"; } 456 | ||
11 | | ^ | ||
12 | 2| | ||
13 | |||
14 | … while calling the 'abort' builtin | ||
15 | at /pwd/lang/eval-fail-deepseq.nix:1:24: | ||
16 | 1| builtins.deepSeq { x = abort "foo"; } 456 | ||
17 | | ^ | ||
18 | 2| | ||
19 | |||
20 | error: evaluation aborted with the following error message: 'foo' | ||
diff --git a/test/testdata/eval-fail-deepseq.nix b/test/testdata/eval-fail-deepseq.nix new file mode 100644 index 0000000..9baa49b --- /dev/null +++ b/test/testdata/eval-fail-deepseq.nix | |||
@@ -0,0 +1 @@ | |||
builtins.deepSeq { x = abort "foo"; } 456 | |||
diff --git a/test/testdata/eval-fail-derivation-name.err.exp b/test/testdata/eval-fail-derivation-name.err.exp new file mode 100644 index 0000000..0ef9867 --- /dev/null +++ b/test/testdata/eval-fail-derivation-name.err.exp | |||
@@ -0,0 +1,26 @@ | |||
1 | error: | ||
2 | … while evaluating the attribute 'outPath' | ||
3 | at <nix/derivation-internal.nix>:<number>:<number>: | ||
4 | <number>| value = commonAttrs // { | ||
5 | <number>| outPath = builtins.getAttr outputName strict; | ||
6 | | ^ | ||
7 | <number>| drvPath = strict.drvPath; | ||
8 | |||
9 | … while calling the 'getAttr' builtin | ||
10 | at <nix/derivation-internal.nix>:<number>:<number>: | ||
11 | <number>| value = commonAttrs // { | ||
12 | <number>| outPath = builtins.getAttr outputName strict; | ||
13 | | ^ | ||
14 | <number>| drvPath = strict.drvPath; | ||
15 | |||
16 | … while calling the 'derivationStrict' builtin | ||
17 | at <nix/derivation-internal.nix>:<number>:<number>: | ||
18 | <number>| | ||
19 | <number>| strict = derivationStrict drvAttrs; | ||
20 | | ^ | ||
21 | <number>| | ||
22 | |||
23 | … while evaluating derivation '~jiggle~' | ||
24 | whose name attribute is located at /pwd/lang/eval-fail-derivation-name.nix:<number>:<number> | ||
25 | |||
26 | error: invalid derivation name: name '~jiggle~' contains illegal character '~'. Please pass a different 'name'. | ||
diff --git a/test/testdata/eval-fail-derivation-name.nix b/test/testdata/eval-fail-derivation-name.nix new file mode 100644 index 0000000..e779ad6 --- /dev/null +++ b/test/testdata/eval-fail-derivation-name.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | derivation { | ||
2 | name = "~jiggle~"; | ||
3 | system = "some-system"; | ||
4 | builder = "/dontcare"; | ||
5 | } | ||
diff --git a/test/testdata/eval-fail-derivation-name.postprocess b/test/testdata/eval-fail-derivation-name.postprocess new file mode 100644 index 0000000..ffbc2b5 --- /dev/null +++ b/test/testdata/eval-fail-derivation-name.postprocess | |||
@@ -0,0 +1,9 @@ | |||
1 | # shellcheck shell=bash | ||
2 | set -euo pipefail | ||
3 | testcaseBasename=$1 | ||
4 | |||
5 | # Line numbers change when derivation.nix docs are updated. | ||
6 | sed -i "$testcaseBasename.err" \ | ||
7 | -e 's/[0-9 ][0-9 ][0-9 ][0-9 ][0-9 ][0-9 ][0-9 ][0-9]\([^0-9]\)/<number>\1/g' \ | ||
8 | -e 's/[0-9][0-9]*/<number>/g' \ | ||
9 | ; | ||
diff --git a/test/testdata/eval-fail-dup-dynamic-attrs.err.exp b/test/testdata/eval-fail-dup-dynamic-attrs.err.exp new file mode 100644 index 0000000..834f9c6 --- /dev/null +++ b/test/testdata/eval-fail-dup-dynamic-attrs.err.exp | |||
@@ -0,0 +1,14 @@ | |||
1 | error: | ||
2 | … while evaluating the attribute 'set' | ||
3 | at /pwd/lang/eval-fail-dup-dynamic-attrs.nix:2:3: | ||
4 | 1| { | ||
5 | 2| set = { "${"" + "b"}" = 1; }; | ||
6 | | ^ | ||
7 | 3| set = { "${"b" + ""}" = 2; }; | ||
8 | |||
9 | error: dynamic attribute 'b' already defined at /pwd/lang/eval-fail-dup-dynamic-attrs.nix:2:11 | ||
10 | at /pwd/lang/eval-fail-dup-dynamic-attrs.nix:3:11: | ||
11 | 2| set = { "${"" + "b"}" = 1; }; | ||
12 | 3| set = { "${"b" + ""}" = 2; }; | ||
13 | | ^ | ||
14 | 4| } | ||
diff --git a/test/testdata/eval-fail-dup-dynamic-attrs.nix b/test/testdata/eval-fail-dup-dynamic-attrs.nix new file mode 100644 index 0000000..7ea17f6 --- /dev/null +++ b/test/testdata/eval-fail-dup-dynamic-attrs.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | { | ||
2 | set = { "${"" + "b"}" = 1; }; | ||
3 | set = { "${"b" + ""}" = 2; }; | ||
4 | } | ||
diff --git a/test/testdata/eval-fail-duplicate-traces.err.exp b/test/testdata/eval-fail-duplicate-traces.err.exp new file mode 100644 index 0000000..cedaebd --- /dev/null +++ b/test/testdata/eval-fail-duplicate-traces.err.exp | |||
@@ -0,0 +1,51 @@ | |||
1 | error: | ||
2 | … from call site | ||
3 | at /pwd/lang/eval-fail-duplicate-traces.nix:9:3: | ||
4 | 8| in | ||
5 | 9| throwAfter 2 | ||
6 | | ^ | ||
7 | 10| | ||
8 | |||
9 | … while calling 'throwAfter' | ||
10 | at /pwd/lang/eval-fail-duplicate-traces.nix:4:16: | ||
11 | 3| let | ||
12 | 4| throwAfter = n: | ||
13 | | ^ | ||
14 | 5| if n > 0 | ||
15 | |||
16 | … from call site | ||
17 | at /pwd/lang/eval-fail-duplicate-traces.nix:6:10: | ||
18 | 5| if n > 0 | ||
19 | 6| then throwAfter (n - 1) | ||
20 | | ^ | ||
21 | 7| else throw "Uh oh!"; | ||
22 | |||
23 | … while calling 'throwAfter' | ||
24 | at /pwd/lang/eval-fail-duplicate-traces.nix:4:16: | ||
25 | 3| let | ||
26 | 4| throwAfter = n: | ||
27 | | ^ | ||
28 | 5| if n > 0 | ||
29 | |||
30 | … from call site | ||
31 | at /pwd/lang/eval-fail-duplicate-traces.nix:6:10: | ||
32 | 5| if n > 0 | ||
33 | 6| then throwAfter (n - 1) | ||
34 | | ^ | ||
35 | 7| else throw "Uh oh!"; | ||
36 | |||
37 | … while calling 'throwAfter' | ||
38 | at /pwd/lang/eval-fail-duplicate-traces.nix:4:16: | ||
39 | 3| let | ||
40 | 4| throwAfter = n: | ||
41 | | ^ | ||
42 | 5| if n > 0 | ||
43 | |||
44 | … while calling the 'throw' builtin | ||
45 | at /pwd/lang/eval-fail-duplicate-traces.nix:7:10: | ||
46 | 6| then throwAfter (n - 1) | ||
47 | 7| else throw "Uh oh!"; | ||
48 | | ^ | ||
49 | 8| in | ||
50 | |||
51 | error: Uh oh! | ||
diff --git a/test/testdata/eval-fail-duplicate-traces.nix b/test/testdata/eval-fail-duplicate-traces.nix new file mode 100644 index 0000000..17ce374 --- /dev/null +++ b/test/testdata/eval-fail-duplicate-traces.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | # Check that we only omit duplicate stack traces when there's a bunch of them. | ||
2 | # Here, there's only a couple duplicate entries, so we output them all. | ||
3 | let | ||
4 | throwAfter = n: | ||
5 | if n > 0 | ||
6 | then throwAfter (n - 1) | ||
7 | else throw "Uh oh!"; | ||
8 | in | ||
9 | throwAfter 2 | ||
diff --git a/test/testdata/eval-fail-eol-1.err.exp b/test/testdata/eval-fail-eol-1.err.exp new file mode 100644 index 0000000..3f5a5c2 --- /dev/null +++ b/test/testdata/eval-fail-eol-1.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: undefined variable 'invalid' | ||
2 | at /pwd/lang/eval-fail-eol-1.nix:2:1: | ||
3 | 1| # foo | ||
4 | 2| invalid | ||
5 | | ^ | ||
6 | 3| # bar | ||
diff --git a/test/testdata/eval-fail-eol-1.nix b/test/testdata/eval-fail-eol-1.nix new file mode 100644 index 0000000..4762239 --- /dev/null +++ b/test/testdata/eval-fail-eol-1.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | # foo | ||
2 | invalid | ||
3 | # bar | ||
diff --git a/test/testdata/eval-fail-eol-2.err.exp b/test/testdata/eval-fail-eol-2.err.exp new file mode 100644 index 0000000..ff13e2d --- /dev/null +++ b/test/testdata/eval-fail-eol-2.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: undefined variable 'invalid' | ||
2 | at /pwd/lang/eval-fail-eol-2.nix:2:1: | ||
3 | 1| # foo | ||
4 | 2| invalid | ||
5 | | ^ | ||
6 | 3| # bar | ||
diff --git a/test/testdata/eval-fail-eol-2.nix b/test/testdata/eval-fail-eol-2.nix new file mode 100644 index 0000000..0cf92a4 --- /dev/null +++ b/test/testdata/eval-fail-eol-2.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | # foo invalid | ||
2 | # bar | ||
diff --git a/test/testdata/eval-fail-eol-3.err.exp b/test/testdata/eval-fail-eol-3.err.exp new file mode 100644 index 0000000..ada3c5e --- /dev/null +++ b/test/testdata/eval-fail-eol-3.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: undefined variable 'invalid' | ||
2 | at /pwd/lang/eval-fail-eol-3.nix:2:1: | ||
3 | 1| # foo | ||
4 | 2| invalid | ||
5 | | ^ | ||
6 | 3| # bar | ||
diff --git a/test/testdata/eval-fail-eol-3.nix b/test/testdata/eval-fail-eol-3.nix new file mode 100644 index 0000000..4762239 --- /dev/null +++ b/test/testdata/eval-fail-eol-3.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | # foo | ||
2 | invalid | ||
3 | # bar | ||
diff --git a/test/testdata/eval-fail-fetchTree-negative.err.exp b/test/testdata/eval-fail-fetchTree-negative.err.exp new file mode 100644 index 0000000..d9ba1f0 --- /dev/null +++ b/test/testdata/eval-fail-fetchTree-negative.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while calling the 'fetchTree' builtin | ||
3 | at /pwd/lang/eval-fail-fetchTree-negative.nix:1:1: | ||
4 | 1| builtins.fetchTree { | ||
5 | | ^ | ||
6 | 2| type = "file"; | ||
7 | |||
8 | error: negative value given for fetchTree attr owner: -1 | ||
diff --git a/test/testdata/eval-fail-fetchTree-negative.nix b/test/testdata/eval-fail-fetchTree-negative.nix new file mode 100644 index 0000000..90bcab5 --- /dev/null +++ b/test/testdata/eval-fail-fetchTree-negative.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | builtins.fetchTree { | ||
2 | type = "file"; | ||
3 | url = "file://eval-fail-fetchTree-negative.nix"; | ||
4 | owner = -1; | ||
5 | } | ||
diff --git a/test/testdata/eval-fail-fetchurl-baseName-attrs-name.err.exp b/test/testdata/eval-fail-fetchurl-baseName-attrs-name.err.exp new file mode 100644 index 0000000..30f8b6a --- /dev/null +++ b/test/testdata/eval-fail-fetchurl-baseName-attrs-name.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while calling the 'fetchurl' builtin | ||
3 | at /pwd/lang/eval-fail-fetchurl-baseName-attrs-name.nix:1:1: | ||
4 | 1| builtins.fetchurl { url = "https://example.com/foo.tar.gz"; name = "~wobble~"; } | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: invalid store path name when fetching URL 'https://example.com/foo.tar.gz': name '~wobble~' contains illegal character '~'. Please change the value for the 'name' attribute passed to 'fetchurl', so that it can create a valid store path. | ||
diff --git a/test/testdata/eval-fail-fetchurl-baseName-attrs-name.nix b/test/testdata/eval-fail-fetchurl-baseName-attrs-name.nix new file mode 100644 index 0000000..5838055 --- /dev/null +++ b/test/testdata/eval-fail-fetchurl-baseName-attrs-name.nix | |||
@@ -0,0 +1 @@ | |||
builtins.fetchurl { url = "https://example.com/foo.tar.gz"; name = "~wobble~"; } | |||
diff --git a/test/testdata/eval-fail-fetchurl-baseName-attrs.err.exp b/test/testdata/eval-fail-fetchurl-baseName-attrs.err.exp new file mode 100644 index 0000000..cef532e --- /dev/null +++ b/test/testdata/eval-fail-fetchurl-baseName-attrs.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while calling the 'fetchurl' builtin | ||
3 | at /pwd/lang/eval-fail-fetchurl-baseName-attrs.nix:1:1: | ||
4 | 1| builtins.fetchurl { url = "https://example.com/~wiggle~"; } | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: invalid store path name when fetching URL 'https://example.com/~wiggle~': name '~wiggle~' contains illegal character '~'. Please add a valid 'name' attribute to the argument for 'fetchurl', so that it can create a valid store path. | ||
diff --git a/test/testdata/eval-fail-fetchurl-baseName-attrs.nix b/test/testdata/eval-fail-fetchurl-baseName-attrs.nix new file mode 100644 index 0000000..068120e --- /dev/null +++ b/test/testdata/eval-fail-fetchurl-baseName-attrs.nix | |||
@@ -0,0 +1 @@ | |||
builtins.fetchurl { url = "https://example.com/~wiggle~"; } | |||
diff --git a/test/testdata/eval-fail-fetchurl-baseName.err.exp b/test/testdata/eval-fail-fetchurl-baseName.err.exp new file mode 100644 index 0000000..0950e8e --- /dev/null +++ b/test/testdata/eval-fail-fetchurl-baseName.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while calling the 'fetchurl' builtin | ||
3 | at /pwd/lang/eval-fail-fetchurl-baseName.nix:1:1: | ||
4 | 1| builtins.fetchurl "https://example.com/~wiggle~" | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: invalid store path name when fetching URL 'https://example.com/~wiggle~': name '~wiggle~' contains illegal character '~'. Please pass an attribute set with 'url' and 'name' attributes to 'fetchurl', so that it can create a valid store path. | ||
diff --git a/test/testdata/eval-fail-fetchurl-baseName.nix b/test/testdata/eval-fail-fetchurl-baseName.nix new file mode 100644 index 0000000..9650938 --- /dev/null +++ b/test/testdata/eval-fail-fetchurl-baseName.nix | |||
@@ -0,0 +1 @@ | |||
builtins.fetchurl "https://example.com/~wiggle~" | |||
diff --git a/test/testdata/eval-fail-flake-ref-to-string-negative-integer.err.exp b/test/testdata/eval-fail-flake-ref-to-string-negative-integer.err.exp new file mode 100644 index 0000000..25c8d7e --- /dev/null +++ b/test/testdata/eval-fail-flake-ref-to-string-negative-integer.err.exp | |||
@@ -0,0 +1,14 @@ | |||
1 | error: | ||
2 | … while calling the 'seq' builtin | ||
3 | at /pwd/lang/eval-fail-flake-ref-to-string-negative-integer.nix:1:16: | ||
4 | 1| let n = -1; in builtins.seq n (builtins.flakeRefToString { | ||
5 | | ^ | ||
6 | 2| type = "github"; | ||
7 | |||
8 | … while calling the 'flakeRefToString' builtin | ||
9 | at /pwd/lang/eval-fail-flake-ref-to-string-negative-integer.nix:1:32: | ||
10 | 1| let n = -1; in builtins.seq n (builtins.flakeRefToString { | ||
11 | | ^ | ||
12 | 2| type = "github"; | ||
13 | |||
14 | error: negative value given for flake ref attr repo: -1 | ||
diff --git a/test/testdata/eval-fail-flake-ref-to-string-negative-integer.nix b/test/testdata/eval-fail-flake-ref-to-string-negative-integer.nix new file mode 100644 index 0000000..e0208eb --- /dev/null +++ b/test/testdata/eval-fail-flake-ref-to-string-negative-integer.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | let n = -1; in builtins.seq n (builtins.flakeRefToString { | ||
2 | type = "github"; | ||
3 | owner = "NixOS"; | ||
4 | repo = n; | ||
5 | ref = "23.05"; | ||
6 | dir = "lib"; | ||
7 | }) | ||
diff --git a/test/testdata/eval-fail-foldlStrict-strict-op-application.err.exp b/test/testdata/eval-fail-foldlStrict-strict-op-application.err.exp new file mode 100644 index 0000000..4903bc8 --- /dev/null +++ b/test/testdata/eval-fail-foldlStrict-strict-op-application.err.exp | |||
@@ -0,0 +1,37 @@ | |||
1 | error: | ||
2 | … while calling the 'foldl'' builtin | ||
3 | at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:2:1: | ||
4 | 1| # Tests that the result of applying op is forced even if the value is never used | ||
5 | 2| builtins.foldl' | ||
6 | | ^ | ||
7 | 3| (_: f: f null) | ||
8 | |||
9 | … while calling anonymous lambda | ||
10 | at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:3:7: | ||
11 | 2| builtins.foldl' | ||
12 | 3| (_: f: f null) | ||
13 | | ^ | ||
14 | 4| null | ||
15 | |||
16 | … from call site | ||
17 | at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:3:10: | ||
18 | 2| builtins.foldl' | ||
19 | 3| (_: f: f null) | ||
20 | | ^ | ||
21 | 4| null | ||
22 | |||
23 | … while calling anonymous lambda | ||
24 | at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:5:6: | ||
25 | 4| null | ||
26 | 5| [ (_: throw "Not the final value, but is still forced!") (_: 23) ] | ||
27 | | ^ | ||
28 | 6| | ||
29 | |||
30 | … while calling the 'throw' builtin | ||
31 | at /pwd/lang/eval-fail-foldlStrict-strict-op-application.nix:5:9: | ||
32 | 4| null | ||
33 | 5| [ (_: throw "Not the final value, but is still forced!") (_: 23) ] | ||
34 | | ^ | ||
35 | 6| | ||
36 | |||
37 | error: Not the final value, but is still forced! | ||
diff --git a/test/testdata/eval-fail-foldlStrict-strict-op-application.nix b/test/testdata/eval-fail-foldlStrict-strict-op-application.nix new file mode 100644 index 0000000..1620cc7 --- /dev/null +++ b/test/testdata/eval-fail-foldlStrict-strict-op-application.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | # Tests that the result of applying op is forced even if the value is never used | ||
2 | builtins.foldl' | ||
3 | (_: f: f null) | ||
4 | null | ||
5 | [ (_: throw "Not the final value, but is still forced!") (_: 23) ] | ||
diff --git a/test/testdata/eval-fail-fromJSON-overflowing.err.exp b/test/testdata/eval-fail-fromJSON-overflowing.err.exp new file mode 100644 index 0000000..a39082b --- /dev/null +++ b/test/testdata/eval-fail-fromJSON-overflowing.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while calling the 'fromJSON' builtin | ||
3 | at /pwd/lang/eval-fail-fromJSON-overflowing.nix:1:1: | ||
4 | 1| builtins.fromJSON ''{"attr": 18446744073709551615}'' | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: unsigned json number 18446744073709551615 outside of Nix integer range | ||
diff --git a/test/testdata/eval-fail-fromJSON-overflowing.nix b/test/testdata/eval-fail-fromJSON-overflowing.nix new file mode 100644 index 0000000..6dfbce3 --- /dev/null +++ b/test/testdata/eval-fail-fromJSON-overflowing.nix | |||
@@ -0,0 +1 @@ | |||
builtins.fromJSON ''{"attr": 18446744073709551615}'' | |||
diff --git a/test/testdata/eval-fail-fromTOML-timestamps.err.exp b/test/testdata/eval-fail-fromTOML-timestamps.err.exp new file mode 100644 index 0000000..9bbb251 --- /dev/null +++ b/test/testdata/eval-fail-fromTOML-timestamps.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while calling the 'fromTOML' builtin | ||
3 | at /pwd/lang/eval-fail-fromTOML-timestamps.nix:1:1: | ||
4 | 1| builtins.fromTOML '' | ||
5 | | ^ | ||
6 | 2| key = "value" | ||
7 | |||
8 | error: while parsing TOML: Dates and times are not supported | ||
diff --git a/test/testdata/eval-fail-fromTOML-timestamps.nix b/test/testdata/eval-fail-fromTOML-timestamps.nix new file mode 100644 index 0000000..74cff94 --- /dev/null +++ b/test/testdata/eval-fail-fromTOML-timestamps.nix | |||
@@ -0,0 +1,130 @@ | |||
1 | builtins.fromTOML '' | ||
2 | key = "value" | ||
3 | bare_key = "value" | ||
4 | bare-key = "value" | ||
5 | 1234 = "value" | ||
6 | |||
7 | "127.0.0.1" = "value" | ||
8 | "character encoding" = "value" | ||
9 | "ʎǝʞ" = "value" | ||
10 | 'key2' = "value" | ||
11 | 'quoted "value"' = "value" | ||
12 | |||
13 | name = "Orange" | ||
14 | |||
15 | physical.color = "orange" | ||
16 | physical.shape = "round" | ||
17 | site."google.com" = true | ||
18 | |||
19 | # This is legal according to the spec, but cpptoml doesn't handle it. | ||
20 | #a.b.c = 1 | ||
21 | #a.d = 2 | ||
22 | |||
23 | str = "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF." | ||
24 | |||
25 | int1 = +99 | ||
26 | int2 = 42 | ||
27 | int3 = 0 | ||
28 | int4 = -17 | ||
29 | int5 = 1_000 | ||
30 | int6 = 5_349_221 | ||
31 | int7 = 1_2_3_4_5 | ||
32 | |||
33 | hex1 = 0xDEADBEEF | ||
34 | hex2 = 0xdeadbeef | ||
35 | hex3 = 0xdead_beef | ||
36 | |||
37 | oct1 = 0o01234567 | ||
38 | oct2 = 0o755 | ||
39 | |||
40 | bin1 = 0b11010110 | ||
41 | |||
42 | flt1 = +1.0 | ||
43 | flt2 = 3.1415 | ||
44 | flt3 = -0.01 | ||
45 | flt4 = 5e+22 | ||
46 | flt5 = 1e6 | ||
47 | flt6 = -2E-2 | ||
48 | flt7 = 6.626e-34 | ||
49 | flt8 = 9_224_617.445_991_228_313 | ||
50 | |||
51 | bool1 = true | ||
52 | bool2 = false | ||
53 | |||
54 | odt1 = 1979-05-27T07:32:00Z | ||
55 | odt2 = 1979-05-27T00:32:00-07:00 | ||
56 | odt3 = 1979-05-27T00:32:00.999999-07:00 | ||
57 | odt4 = 1979-05-27 07:32:00Z | ||
58 | ldt1 = 1979-05-27T07:32:00 | ||
59 | ldt2 = 1979-05-27T00:32:00.999999 | ||
60 | ld1 = 1979-05-27 | ||
61 | lt1 = 07:32:00 | ||
62 | lt2 = 00:32:00.999999 | ||
63 | |||
64 | arr1 = [ 1, 2, 3 ] | ||
65 | arr2 = [ "red", "yellow", "green" ] | ||
66 | arr3 = [ [ 1, 2 ], [3, 4, 5] ] | ||
67 | arr4 = [ "all", 'strings', """are the same""", ''''type''''] | ||
68 | arr5 = [ [ 1, 2 ], ["a", "b", "c"] ] | ||
69 | |||
70 | arr7 = [ | ||
71 | 1, 2, 3 | ||
72 | ] | ||
73 | |||
74 | arr8 = [ | ||
75 | 1, | ||
76 | 2, # this is ok | ||
77 | ] | ||
78 | |||
79 | [table-1] | ||
80 | key1 = "some string" | ||
81 | key2 = 123 | ||
82 | |||
83 | |||
84 | [table-2] | ||
85 | key1 = "another string" | ||
86 | key2 = 456 | ||
87 | |||
88 | [dog."tater.man"] | ||
89 | type.name = "pug" | ||
90 | |||
91 | [a.b.c] | ||
92 | [ d.e.f ] | ||
93 | [ g . h . i ] | ||
94 | [ j . "ʞ" . 'l' ] | ||
95 | [x.y.z.w] | ||
96 | |||
97 | name = { first = "Tom", last = "Preston-Werner" } | ||
98 | point = { x = 1, y = 2 } | ||
99 | animal = { type.name = "pug" } | ||
100 | |||
101 | [[products]] | ||
102 | name = "Hammer" | ||
103 | sku = 738594937 | ||
104 | |||
105 | [[products]] | ||
106 | |||
107 | [[products]] | ||
108 | name = "Nail" | ||
109 | sku = 284758393 | ||
110 | color = "gray" | ||
111 | |||
112 | [[fruit]] | ||
113 | name = "apple" | ||
114 | |||
115 | [fruit.physical] | ||
116 | color = "red" | ||
117 | shape = "round" | ||
118 | |||
119 | [[fruit.variety]] | ||
120 | name = "red delicious" | ||
121 | |||
122 | [[fruit.variety]] | ||
123 | name = "granny smith" | ||
124 | |||
125 | [[fruit]] | ||
126 | name = "banana" | ||
127 | |||
128 | [[fruit.variety]] | ||
129 | name = "plantain" | ||
130 | '' | ||
diff --git a/test/testdata/eval-fail-hashfile-missing.err.exp b/test/testdata/eval-fail-hashfile-missing.err.exp new file mode 100644 index 0000000..1e46539 --- /dev/null +++ b/test/testdata/eval-fail-hashfile-missing.err.exp | |||
@@ -0,0 +1,13 @@ | |||
1 | error: | ||
2 | … while calling the 'toString' builtin | ||
3 | at /pwd/lang/eval-fail-hashfile-missing.nix:4:3: | ||
4 | 3| in | ||
5 | 4| toString (builtins.concatLists (map (hash: map (builtins.hashFile hash) paths) ["md5" "sha1" "sha256" "sha512"])) | ||
6 | | ^ | ||
7 | 5| | ||
8 | |||
9 | … while evaluating the first argument passed to builtins.toString | ||
10 | |||
11 | … while calling the 'hashFile' builtin | ||
12 | |||
13 | error: opening file '/pwd/lang/this-file-is-definitely-not-there-7392097': No such file or directory | ||
diff --git a/test/testdata/eval-fail-hashfile-missing.nix b/test/testdata/eval-fail-hashfile-missing.nix new file mode 100644 index 0000000..ce098b8 --- /dev/null +++ b/test/testdata/eval-fail-hashfile-missing.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | let | ||
2 | paths = [ ./this-file-is-definitely-not-there-7392097 "/and/neither/is/this/37293620" ]; | ||
3 | in | ||
4 | toString (builtins.concatLists (map (hash: map (builtins.hashFile hash) paths) ["md5" "sha1" "sha256" "sha512"])) | ||
5 | |||
diff --git a/test/testdata/eval-fail-infinite-recursion-lambda.err.exp b/test/testdata/eval-fail-infinite-recursion-lambda.err.exp new file mode 100644 index 0000000..712dd75 --- /dev/null +++ b/test/testdata/eval-fail-infinite-recursion-lambda.err.exp | |||
@@ -0,0 +1,38 @@ | |||
1 | error: | ||
2 | … from call site | ||
3 | at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:1: | ||
4 | 1| (x: x x) (x: x x) | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | … while calling anonymous lambda | ||
9 | at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:2: | ||
10 | 1| (x: x x) (x: x x) | ||
11 | | ^ | ||
12 | 2| | ||
13 | |||
14 | … from call site | ||
15 | at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:5: | ||
16 | 1| (x: x x) (x: x x) | ||
17 | | ^ | ||
18 | 2| | ||
19 | |||
20 | … while calling anonymous lambda | ||
21 | at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:11: | ||
22 | 1| (x: x x) (x: x x) | ||
23 | | ^ | ||
24 | 2| | ||
25 | |||
26 | … from call site | ||
27 | at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:14: | ||
28 | 1| (x: x x) (x: x x) | ||
29 | | ^ | ||
30 | 2| | ||
31 | |||
32 | (197 duplicate frames omitted) | ||
33 | |||
34 | error: stack overflow; max-call-depth exceeded | ||
35 | at /pwd/lang/eval-fail-infinite-recursion-lambda.nix:1:14: | ||
36 | 1| (x: x x) (x: x x) | ||
37 | | ^ | ||
38 | 2| | ||
diff --git a/test/testdata/eval-fail-infinite-recursion-lambda.flags b/test/testdata/eval-fail-infinite-recursion-lambda.flags new file mode 100644 index 0000000..59e20ec --- /dev/null +++ b/test/testdata/eval-fail-infinite-recursion-lambda.flags | |||
@@ -0,0 +1 @@ | |||
--max-call-depth 100 \ No newline at end of file | |||
diff --git a/test/testdata/eval-fail-infinite-recursion-lambda.nix b/test/testdata/eval-fail-infinite-recursion-lambda.nix new file mode 100644 index 0000000..dd0a8bf --- /dev/null +++ b/test/testdata/eval-fail-infinite-recursion-lambda.nix | |||
@@ -0,0 +1 @@ | |||
(x: x x) (x: x x) | |||
diff --git a/test/testdata/eval-fail-list.err.exp b/test/testdata/eval-fail-list.err.exp new file mode 100644 index 0000000..d492f8b --- /dev/null +++ b/test/testdata/eval-fail-list.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while evaluating one of the elements to concatenate | ||
3 | at /pwd/lang/eval-fail-list.nix:1:2: | ||
4 | 1| 8++1 | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: expected a list but found an integer: 8 | ||
diff --git a/test/testdata/eval-fail-list.nix b/test/testdata/eval-fail-list.nix new file mode 100644 index 0000000..fa749f2 --- /dev/null +++ b/test/testdata/eval-fail-list.nix | |||
@@ -0,0 +1 @@ | |||
8++1 | |||
diff --git a/test/testdata/eval-fail-missing-arg.err.exp b/test/testdata/eval-fail-missing-arg.err.exp new file mode 100644 index 0000000..3b162fe --- /dev/null +++ b/test/testdata/eval-fail-missing-arg.err.exp | |||
@@ -0,0 +1,12 @@ | |||
1 | error: | ||
2 | … from call site | ||
3 | at /pwd/lang/eval-fail-missing-arg.nix:1:1: | ||
4 | 1| ({x, y, z}: x + y + z) {x = "foo"; z = "bar";} | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: function 'anonymous lambda' called without required argument 'y' | ||
9 | at /pwd/lang/eval-fail-missing-arg.nix:1:2: | ||
10 | 1| ({x, y, z}: x + y + z) {x = "foo"; z = "bar";} | ||
11 | | ^ | ||
12 | 2| | ||
diff --git a/test/testdata/eval-fail-missing-arg.nix b/test/testdata/eval-fail-missing-arg.nix new file mode 100644 index 0000000..c4be979 --- /dev/null +++ b/test/testdata/eval-fail-missing-arg.nix | |||
@@ -0,0 +1 @@ | |||
({x, y, z}: x + y + z) {x = "foo"; z = "bar";} | |||
diff --git a/test/testdata/eval-fail-mutual-recursion.err.exp b/test/testdata/eval-fail-mutual-recursion.err.exp new file mode 100644 index 0000000..c034afc --- /dev/null +++ b/test/testdata/eval-fail-mutual-recursion.err.exp | |||
@@ -0,0 +1,64 @@ | |||
1 | error: | ||
2 | … from call site | ||
3 | at /pwd/lang/eval-fail-mutual-recursion.nix:36:3: | ||
4 | 35| in | ||
5 | 36| throwAfterA true 10 | ||
6 | | ^ | ||
7 | 37| | ||
8 | |||
9 | … while calling 'throwAfterA' | ||
10 | at /pwd/lang/eval-fail-mutual-recursion.nix:29:26: | ||
11 | 28| | ||
12 | 29| throwAfterA = recurse: n: | ||
13 | | ^ | ||
14 | 30| if n > 0 | ||
15 | |||
16 | … from call site | ||
17 | at /pwd/lang/eval-fail-mutual-recursion.nix:31:10: | ||
18 | 30| if n > 0 | ||
19 | 31| then throwAfterA recurse (n - 1) | ||
20 | | ^ | ||
21 | 32| else if recurse | ||
22 | |||
23 | (19 duplicate frames omitted) | ||
24 | |||
25 | … from call site | ||
26 | at /pwd/lang/eval-fail-mutual-recursion.nix:33:10: | ||
27 | 32| else if recurse | ||
28 | 33| then throwAfterB true 10 | ||
29 | | ^ | ||
30 | 34| else throw "Uh oh!"; | ||
31 | |||
32 | … while calling 'throwAfterB' | ||
33 | at /pwd/lang/eval-fail-mutual-recursion.nix:22:26: | ||
34 | 21| let | ||
35 | 22| throwAfterB = recurse: n: | ||
36 | | ^ | ||
37 | 23| if n > 0 | ||
38 | |||
39 | … from call site | ||
40 | at /pwd/lang/eval-fail-mutual-recursion.nix:24:10: | ||
41 | 23| if n > 0 | ||
42 | 24| then throwAfterB recurse (n - 1) | ||
43 | | ^ | ||
44 | 25| else if recurse | ||
45 | |||
46 | (19 duplicate frames omitted) | ||
47 | |||
48 | … from call site | ||
49 | at /pwd/lang/eval-fail-mutual-recursion.nix:26:10: | ||
50 | 25| else if recurse | ||
51 | 26| then throwAfterA false 10 | ||
52 | | ^ | ||
53 | 27| else throw "Uh oh!"; | ||
54 | |||
55 | (21 duplicate frames omitted) | ||
56 | |||
57 | … while calling the 'throw' builtin | ||
58 | at /pwd/lang/eval-fail-mutual-recursion.nix:34:10: | ||
59 | 33| then throwAfterB true 10 | ||
60 | 34| else throw "Uh oh!"; | ||
61 | | ^ | ||
62 | 35| in | ||
63 | |||
64 | error: Uh oh! | ||
diff --git a/test/testdata/eval-fail-mutual-recursion.nix b/test/testdata/eval-fail-mutual-recursion.nix new file mode 100644 index 0000000..d090d31 --- /dev/null +++ b/test/testdata/eval-fail-mutual-recursion.nix | |||
@@ -0,0 +1,36 @@ | |||
1 | # Check that stack frame deduplication only affects consecutive intervals, and | ||
2 | # that they are reported independently of any preceding sections, even if | ||
3 | # they're indistinguishable. | ||
4 | # | ||
5 | # In terms of the current implementation, we check that we clear the set of | ||
6 | # "seen frames" after eliding a group of frames. | ||
7 | # | ||
8 | # Suppose we have: | ||
9 | # - 10 frames in a function A | ||
10 | # - 10 frames in a function B | ||
11 | # - 10 frames in a function A | ||
12 | # | ||
13 | # We want to output: | ||
14 | # - a few frames of A (skip the rest) | ||
15 | # - a few frames of B (skip the rest) | ||
16 | # - a few frames of A (skip the rest) | ||
17 | # | ||
18 | # If we implemented this in the naive manner, we'd instead get: | ||
19 | # - a few frames of A (skip the rest) | ||
20 | # - a few frames of B (skip the rest, _and_ skip the remaining frames of A) | ||
21 | let | ||
22 | throwAfterB = recurse: n: | ||
23 | if n > 0 | ||
24 | then throwAfterB recurse (n - 1) | ||
25 | else if recurse | ||
26 | then throwAfterA false 10 | ||
27 | else throw "Uh oh!"; | ||
28 | |||
29 | throwAfterA = recurse: n: | ||
30 | if n > 0 | ||
31 | then throwAfterA recurse (n - 1) | ||
32 | else if recurse | ||
33 | then throwAfterB true 10 | ||
34 | else throw "Uh oh!"; | ||
35 | in | ||
36 | throwAfterA true 10 | ||
diff --git a/test/testdata/eval-fail-nested-list-items.err.exp b/test/testdata/eval-fail-nested-list-items.err.exp new file mode 100644 index 0000000..90d4390 --- /dev/null +++ b/test/testdata/eval-fail-nested-list-items.err.exp | |||
@@ -0,0 +1,9 @@ | |||
1 | error: | ||
2 | … while evaluating a path segment | ||
3 | at /pwd/lang/eval-fail-nested-list-items.nix:11:6: | ||
4 | 10| | ||
5 | 11| "" + (let v = [ [ 1 2 3 4 5 6 7 8 ] [1 2 3 4]]; in builtins.deepSeq v v) | ||
6 | | ^ | ||
7 | 12| | ||
8 | |||
9 | error: cannot coerce a list to a string: [ [ 1 2 3 4 5 6 7 8 ] [ 1 «3 items elided» ] ] | ||
diff --git a/test/testdata/eval-fail-nested-list-items.nix b/test/testdata/eval-fail-nested-list-items.nix new file mode 100644 index 0000000..af45b1d --- /dev/null +++ b/test/testdata/eval-fail-nested-list-items.nix | |||
@@ -0,0 +1,11 @@ | |||
1 | # This reproduces https://github.com/NixOS/nix/issues/10993, for lists | ||
2 | # $ nix run nix/2.23.1 -- eval --expr '"" + (let v = [ [ 1 2 3 4 5 6 7 8 ] [1 2 3 4]]; in builtins.deepSeq v v)' | ||
3 | # error: | ||
4 | # … while evaluating a path segment | ||
5 | # at «string»:1:6: | ||
6 | # 1| "" + (let v = [ [ 1 2 3 4 5 6 7 8 ] [1 2 3 4]]; in builtins.deepSeq v v) | ||
7 | # | ^ | ||
8 | # | ||
9 | # error: cannot coerce a list to a string: [ [ 1 2 3 4 5 6 7 8 ] [ 1 «4294967290 items elided» ] ] | ||
10 | |||
11 | "" + (let v = [ [ 1 2 3 4 5 6 7 8 ] [1 2 3 4]]; in builtins.deepSeq v v) | ||
diff --git a/test/testdata/eval-fail-nonexist-path.err.exp b/test/testdata/eval-fail-nonexist-path.err.exp new file mode 100644 index 0000000..a287067 --- /dev/null +++ b/test/testdata/eval-fail-nonexist-path.err.exp | |||
@@ -0,0 +1 @@ | |||
error: path '/pwd/lang/fnord' does not exist | |||
diff --git a/test/testdata/eval-fail-nonexist-path.nix b/test/testdata/eval-fail-nonexist-path.nix new file mode 100644 index 0000000..f2f0810 --- /dev/null +++ b/test/testdata/eval-fail-nonexist-path.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | # This must fail to evaluate, since ./fnord doesn't exist. If it did | ||
2 | # exist, it would produce "/nix/store/<hash>-fnord/xyzzy" (with an | ||
3 | # appropriate context). | ||
4 | "${./fnord}/xyzzy" | ||
diff --git a/test/testdata/eval-fail-not-throws.err.exp b/test/testdata/eval-fail-not-throws.err.exp new file mode 100644 index 0000000..fc81f72 --- /dev/null +++ b/test/testdata/eval-fail-not-throws.err.exp | |||
@@ -0,0 +1,14 @@ | |||
1 | error: | ||
2 | … in the argument of the not operator | ||
3 | at /pwd/lang/eval-fail-not-throws.nix:1:4: | ||
4 | 1| ! (throw "uh oh!") | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | … while calling the 'throw' builtin | ||
9 | at /pwd/lang/eval-fail-not-throws.nix:1:4: | ||
10 | 1| ! (throw "uh oh!") | ||
11 | | ^ | ||
12 | 2| | ||
13 | |||
14 | error: uh oh! | ||
diff --git a/test/testdata/eval-fail-not-throws.nix b/test/testdata/eval-fail-not-throws.nix new file mode 100644 index 0000000..a74ce4e --- /dev/null +++ b/test/testdata/eval-fail-not-throws.nix | |||
@@ -0,0 +1 @@ | |||
! (throw "uh oh!") | |||
diff --git a/test/testdata/eval-fail-overflowing-add.err.exp b/test/testdata/eval-fail-overflowing-add.err.exp new file mode 100644 index 0000000..6458cf1 --- /dev/null +++ b/test/testdata/eval-fail-overflowing-add.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: integer overflow in adding 9223372036854775807 + 1 | ||
2 | at /pwd/lang/eval-fail-overflowing-add.nix:4:8: | ||
3 | 3| b = 1; | ||
4 | 4| in a + b | ||
5 | | ^ | ||
6 | 5| | ||
diff --git a/test/testdata/eval-fail-overflowing-add.nix b/test/testdata/eval-fail-overflowing-add.nix new file mode 100644 index 0000000..24258fc --- /dev/null +++ b/test/testdata/eval-fail-overflowing-add.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | let | ||
2 | a = 9223372036854775807; | ||
3 | b = 1; | ||
4 | in a + b | ||
diff --git a/test/testdata/eval-fail-overflowing-div.err.exp b/test/testdata/eval-fail-overflowing-div.err.exp new file mode 100644 index 0000000..8ce07d4 --- /dev/null +++ b/test/testdata/eval-fail-overflowing-div.err.exp | |||
@@ -0,0 +1,23 @@ | |||
1 | error: | ||
2 | … while calling the 'seq' builtin | ||
3 | at /pwd/lang/eval-fail-overflowing-div.nix:7:4: | ||
4 | 6| b = -1; | ||
5 | 7| in builtins.seq intMin (builtins.seq b (intMin / b)) | ||
6 | | ^ | ||
7 | 8| | ||
8 | |||
9 | … while calling the 'seq' builtin | ||
10 | at /pwd/lang/eval-fail-overflowing-div.nix:7:25: | ||
11 | 6| b = -1; | ||
12 | 7| in builtins.seq intMin (builtins.seq b (intMin / b)) | ||
13 | | ^ | ||
14 | 8| | ||
15 | |||
16 | … while calling the 'div' builtin | ||
17 | at /pwd/lang/eval-fail-overflowing-div.nix:7:48: | ||
18 | 6| b = -1; | ||
19 | 7| in builtins.seq intMin (builtins.seq b (intMin / b)) | ||
20 | | ^ | ||
21 | 8| | ||
22 | |||
23 | error: integer overflow in dividing -9223372036854775808 / -1 | ||
diff --git a/test/testdata/eval-fail-overflowing-div.nix b/test/testdata/eval-fail-overflowing-div.nix new file mode 100644 index 0000000..44fbe9d --- /dev/null +++ b/test/testdata/eval-fail-overflowing-div.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | let | ||
2 | # lol, this has to be written as an expression like this because negative | ||
3 | # numbers use unary negation rather than parsing directly, and 2**63 is out | ||
4 | # of range | ||
5 | intMin = -9223372036854775807 - 1; | ||
6 | b = -1; | ||
7 | in builtins.seq intMin (builtins.seq b (intMin / b)) | ||
diff --git a/test/testdata/eval-fail-overflowing-mul.err.exp b/test/testdata/eval-fail-overflowing-mul.err.exp new file mode 100644 index 0000000..f42b39d --- /dev/null +++ b/test/testdata/eval-fail-overflowing-mul.err.exp | |||
@@ -0,0 +1,16 @@ | |||
1 | error: | ||
2 | … while calling the 'mul' builtin | ||
3 | at /pwd/lang/eval-fail-overflowing-mul.nix:3:10: | ||
4 | 2| a = 4294967297; | ||
5 | 3| in a * a * a | ||
6 | | ^ | ||
7 | 4| | ||
8 | |||
9 | … while calling the 'mul' builtin | ||
10 | at /pwd/lang/eval-fail-overflowing-mul.nix:3:6: | ||
11 | 2| a = 4294967297; | ||
12 | 3| in a * a * a | ||
13 | | ^ | ||
14 | 4| | ||
15 | |||
16 | error: integer overflow in multiplying 4294967297 * 4294967297 | ||
diff --git a/test/testdata/eval-fail-overflowing-mul.nix b/test/testdata/eval-fail-overflowing-mul.nix new file mode 100644 index 0000000..6081d9c --- /dev/null +++ b/test/testdata/eval-fail-overflowing-mul.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | let | ||
2 | a = 4294967297; | ||
3 | in a * a * a | ||
diff --git a/test/testdata/eval-fail-overflowing-sub.err.exp b/test/testdata/eval-fail-overflowing-sub.err.exp new file mode 100644 index 0000000..66a3a03 --- /dev/null +++ b/test/testdata/eval-fail-overflowing-sub.err.exp | |||
@@ -0,0 +1,9 @@ | |||
1 | error: | ||
2 | … while calling the 'sub' builtin | ||
3 | at /pwd/lang/eval-fail-overflowing-sub.nix:4:6: | ||
4 | 3| b = 2; | ||
5 | 4| in a - b | ||
6 | | ^ | ||
7 | 5| | ||
8 | |||
9 | error: integer overflow in subtracting -9223372036854775807 - 2 | ||
diff --git a/test/testdata/eval-fail-overflowing-sub.nix b/test/testdata/eval-fail-overflowing-sub.nix new file mode 100644 index 0000000..229b8c6 --- /dev/null +++ b/test/testdata/eval-fail-overflowing-sub.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | let | ||
2 | a = -9223372036854775807; | ||
3 | b = 2; | ||
4 | in a - b | ||
diff --git a/test/testdata/eval-fail-path-slash.err.exp b/test/testdata/eval-fail-path-slash.err.exp new file mode 100644 index 0000000..e3531d3 --- /dev/null +++ b/test/testdata/eval-fail-path-slash.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: path has a trailing slash | ||
2 | at /pwd/lang/eval-fail-path-slash.nix:6:12: | ||
3 | 5| # and https://nixos.org/nix-dev/2016-June/020829.html | ||
4 | 6| /nix/store/ | ||
5 | | ^ | ||
6 | 7| | ||
diff --git a/test/testdata/eval-fail-path-slash.nix b/test/testdata/eval-fail-path-slash.nix new file mode 100644 index 0000000..8c2e104 --- /dev/null +++ b/test/testdata/eval-fail-path-slash.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | # Trailing slashes in paths are not allowed. | ||
2 | # This restriction could be lifted sometime, | ||
3 | # for example if we make '/' a path concatenation operator. | ||
4 | # See https://github.com/NixOS/nix/issues/1138 | ||
5 | # and https://nixos.org/nix-dev/2016-June/020829.html | ||
6 | /nix/store/ | ||
diff --git a/test/testdata/eval-fail-pipe-operators.err.exp b/test/testdata/eval-fail-pipe-operators.err.exp new file mode 100644 index 0000000..49f3fa8 --- /dev/null +++ b/test/testdata/eval-fail-pipe-operators.err.exp | |||
@@ -0,0 +1,5 @@ | |||
1 | error: experimental Nix feature 'pipe-operators' is disabled; add '--extra-experimental-features pipe-operators' to enable it | ||
2 | at /pwd/lang/eval-fail-pipe-operators.nix:1:3: | ||
3 | 1| 1 |> 2 | ||
4 | | ^ | ||
5 | 2| | ||
diff --git a/test/testdata/eval-fail-pipe-operators.nix b/test/testdata/eval-fail-pipe-operators.nix new file mode 100644 index 0000000..433e0fd --- /dev/null +++ b/test/testdata/eval-fail-pipe-operators.nix | |||
@@ -0,0 +1 @@ | |||
1 |> 2 | |||
diff --git a/test/testdata/eval-fail-recursion.err.exp b/test/testdata/eval-fail-recursion.err.exp new file mode 100644 index 0000000..19380dc --- /dev/null +++ b/test/testdata/eval-fail-recursion.err.exp | |||
@@ -0,0 +1,12 @@ | |||
1 | error: | ||
2 | … in the right operand of the update (//) operator | ||
3 | at /pwd/lang/eval-fail-recursion.nix:1:12: | ||
4 | 1| let a = {} // a; in a.foo | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: infinite recursion encountered | ||
9 | at /pwd/lang/eval-fail-recursion.nix:1:15: | ||
10 | 1| let a = {} // a; in a.foo | ||
11 | | ^ | ||
12 | 2| | ||
diff --git a/test/testdata/eval-fail-recursion.nix b/test/testdata/eval-fail-recursion.nix new file mode 100644 index 0000000..075b5ed --- /dev/null +++ b/test/testdata/eval-fail-recursion.nix | |||
@@ -0,0 +1 @@ | |||
let a = {} // a; in a.foo | |||
diff --git a/test/testdata/eval-fail-remove.err.exp b/test/testdata/eval-fail-remove.err.exp new file mode 100644 index 0000000..292b3c3 --- /dev/null +++ b/test/testdata/eval-fail-remove.err.exp | |||
@@ -0,0 +1,15 @@ | |||
1 | error: | ||
2 | … while evaluating the attribute 'body' | ||
3 | at /pwd/lang/eval-fail-remove.nix:4:3: | ||
4 | 3| | ||
5 | 4| body = (removeAttrs attrs ["x"]).x; | ||
6 | | ^ | ||
7 | 5| } | ||
8 | |||
9 | error: attribute 'x' missing | ||
10 | at /pwd/lang/eval-fail-remove.nix:4:10: | ||
11 | 3| | ||
12 | 4| body = (removeAttrs attrs ["x"]).x; | ||
13 | | ^ | ||
14 | 5| } | ||
15 | Did you mean y? | ||
diff --git a/test/testdata/eval-fail-remove.nix b/test/testdata/eval-fail-remove.nix new file mode 100644 index 0000000..539e0eb --- /dev/null +++ b/test/testdata/eval-fail-remove.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | let { | ||
2 | attrs = {x = 123; y = 456;}; | ||
3 | |||
4 | body = (removeAttrs attrs ["x"]).x; | ||
5 | } \ No newline at end of file | ||
diff --git a/test/testdata/eval-fail-scope-5.err.exp b/test/testdata/eval-fail-scope-5.err.exp new file mode 100644 index 0000000..b0b05ca --- /dev/null +++ b/test/testdata/eval-fail-scope-5.err.exp | |||
@@ -0,0 +1,28 @@ | |||
1 | error: | ||
2 | … while evaluating the attribute 'body' | ||
3 | at /pwd/lang/eval-fail-scope-5.nix:8:3: | ||
4 | 7| | ||
5 | 8| body = f {}; | ||
6 | | ^ | ||
7 | 9| | ||
8 | |||
9 | … from call site | ||
10 | at /pwd/lang/eval-fail-scope-5.nix:8:10: | ||
11 | 7| | ||
12 | 8| body = f {}; | ||
13 | | ^ | ||
14 | 9| | ||
15 | |||
16 | … while calling 'f' | ||
17 | at /pwd/lang/eval-fail-scope-5.nix:6:7: | ||
18 | 5| | ||
19 | 6| f = {x ? y, y ? x}: x + y; | ||
20 | | ^ | ||
21 | 7| | ||
22 | |||
23 | error: infinite recursion encountered | ||
24 | at /pwd/lang/eval-fail-scope-5.nix:6:12: | ||
25 | 5| | ||
26 | 6| f = {x ? y, y ? x}: x + y; | ||
27 | | ^ | ||
28 | 7| | ||
diff --git a/test/testdata/eval-fail-scope-5.nix b/test/testdata/eval-fail-scope-5.nix new file mode 100644 index 0000000..f89a65a --- /dev/null +++ b/test/testdata/eval-fail-scope-5.nix | |||
@@ -0,0 +1,10 @@ | |||
1 | let { | ||
2 | |||
3 | x = "a"; | ||
4 | y = "b"; | ||
5 | |||
6 | f = {x ? y, y ? x}: x + y; | ||
7 | |||
8 | body = f {}; | ||
9 | |||
10 | } | ||
diff --git a/test/testdata/eval-fail-seq.err.exp b/test/testdata/eval-fail-seq.err.exp new file mode 100644 index 0000000..3e3d71b --- /dev/null +++ b/test/testdata/eval-fail-seq.err.exp | |||
@@ -0,0 +1,14 @@ | |||
1 | error: | ||
2 | … while calling the 'seq' builtin | ||
3 | at /pwd/lang/eval-fail-seq.nix:1:1: | ||
4 | 1| builtins.seq (abort "foo") 2 | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | … while calling the 'abort' builtin | ||
9 | at /pwd/lang/eval-fail-seq.nix:1:15: | ||
10 | 1| builtins.seq (abort "foo") 2 | ||
11 | | ^ | ||
12 | 2| | ||
13 | |||
14 | error: evaluation aborted with the following error message: 'foo' | ||
diff --git a/test/testdata/eval-fail-seq.nix b/test/testdata/eval-fail-seq.nix new file mode 100644 index 0000000..cddbbfd --- /dev/null +++ b/test/testdata/eval-fail-seq.nix | |||
@@ -0,0 +1 @@ | |||
builtins.seq (abort "foo") 2 | |||
diff --git a/test/testdata/eval-fail-set-override.err.exp b/test/testdata/eval-fail-set-override.err.exp new file mode 100644 index 0000000..9006ca4 --- /dev/null +++ b/test/testdata/eval-fail-set-override.err.exp | |||
@@ -0,0 +1,4 @@ | |||
1 | error: | ||
2 | … while evaluating the `__overrides` attribute | ||
3 | |||
4 | error: expected a set but found an integer: 1 | ||
diff --git a/test/testdata/eval-fail-set-override.nix b/test/testdata/eval-fail-set-override.nix new file mode 100644 index 0000000..03551c1 --- /dev/null +++ b/test/testdata/eval-fail-set-override.nix | |||
@@ -0,0 +1 @@ | |||
rec { __overrides = 1; } | |||
diff --git a/test/testdata/eval-fail-set.err.exp b/test/testdata/eval-fail-set.err.exp new file mode 100644 index 0000000..6dd646e --- /dev/null +++ b/test/testdata/eval-fail-set.err.exp | |||
@@ -0,0 +1,5 @@ | |||
1 | error: undefined variable 'x' | ||
2 | at /pwd/lang/eval-fail-set.nix:1:3: | ||
3 | 1| 8.x | ||
4 | | ^ | ||
5 | 2| | ||
diff --git a/test/testdata/eval-fail-set.nix b/test/testdata/eval-fail-set.nix new file mode 100644 index 0000000..c6b7980 --- /dev/null +++ b/test/testdata/eval-fail-set.nix | |||
@@ -0,0 +1 @@ | |||
8.x | |||
diff --git a/test/testdata/eval-fail-substring.err.exp b/test/testdata/eval-fail-substring.err.exp new file mode 100644 index 0000000..0457a82 --- /dev/null +++ b/test/testdata/eval-fail-substring.err.exp | |||
@@ -0,0 +1,8 @@ | |||
1 | error: | ||
2 | … while calling the 'substring' builtin | ||
3 | at /pwd/lang/eval-fail-substring.nix:1:1: | ||
4 | 1| builtins.substring (builtins.sub 0 1) 1 "x" | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: negative start position in 'substring' | ||
diff --git a/test/testdata/eval-fail-substring.nix b/test/testdata/eval-fail-substring.nix new file mode 100644 index 0000000..f37c2bc --- /dev/null +++ b/test/testdata/eval-fail-substring.nix | |||
@@ -0,0 +1 @@ | |||
builtins.substring (builtins.sub 0 1) 1 "x" | |||
diff --git a/test/testdata/eval-fail-to-path.err.exp b/test/testdata/eval-fail-to-path.err.exp new file mode 100644 index 0000000..d6b17be --- /dev/null +++ b/test/testdata/eval-fail-to-path.err.exp | |||
@@ -0,0 +1,10 @@ | |||
1 | error: | ||
2 | … while calling the 'toPath' builtin | ||
3 | at /pwd/lang/eval-fail-to-path.nix:1:1: | ||
4 | 1| builtins.toPath "foo/bar" | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | … while evaluating the first argument passed to builtins.toPath | ||
9 | |||
10 | error: string 'foo/bar' doesn't represent an absolute path | ||
diff --git a/test/testdata/eval-fail-to-path.nix b/test/testdata/eval-fail-to-path.nix new file mode 100644 index 0000000..5e322bc --- /dev/null +++ b/test/testdata/eval-fail-to-path.nix | |||
@@ -0,0 +1 @@ | |||
builtins.toPath "foo/bar" | |||
diff --git a/test/testdata/eval-fail-toJSON.err.exp b/test/testdata/eval-fail-toJSON.err.exp new file mode 100644 index 0000000..ad26771 --- /dev/null +++ b/test/testdata/eval-fail-toJSON.err.exp | |||
@@ -0,0 +1,50 @@ | |||
1 | error: | ||
2 | … while calling the 'toJSON' builtin | ||
3 | at /pwd/lang/eval-fail-toJSON.nix:1:1: | ||
4 | 1| builtins.toJSON { | ||
5 | | ^ | ||
6 | 2| a.b = [ | ||
7 | |||
8 | … while evaluating attribute 'a' | ||
9 | at /pwd/lang/eval-fail-toJSON.nix:2:3: | ||
10 | 1| builtins.toJSON { | ||
11 | 2| a.b = [ | ||
12 | | ^ | ||
13 | 3| true | ||
14 | |||
15 | … while evaluating attribute 'b' | ||
16 | at /pwd/lang/eval-fail-toJSON.nix:2:3: | ||
17 | 1| builtins.toJSON { | ||
18 | 2| a.b = [ | ||
19 | | ^ | ||
20 | 3| true | ||
21 | |||
22 | … while evaluating list element at index 3 | ||
23 | at /pwd/lang/eval-fail-toJSON.nix:2:3: | ||
24 | 1| builtins.toJSON { | ||
25 | 2| a.b = [ | ||
26 | | ^ | ||
27 | 3| true | ||
28 | |||
29 | … while evaluating attribute 'c' | ||
30 | at /pwd/lang/eval-fail-toJSON.nix:7:7: | ||
31 | 6| { | ||
32 | 7| c.d = throw "hah no"; | ||
33 | | ^ | ||
34 | 8| } | ||
35 | |||
36 | … while evaluating attribute 'd' | ||
37 | at /pwd/lang/eval-fail-toJSON.nix:7:7: | ||
38 | 6| { | ||
39 | 7| c.d = throw "hah no"; | ||
40 | | ^ | ||
41 | 8| } | ||
42 | |||
43 | … while calling the 'throw' builtin | ||
44 | at /pwd/lang/eval-fail-toJSON.nix:7:13: | ||
45 | 6| { | ||
46 | 7| c.d = throw "hah no"; | ||
47 | | ^ | ||
48 | 8| } | ||
49 | |||
50 | error: hah no | ||
diff --git a/test/testdata/eval-fail-toJSON.nix b/test/testdata/eval-fail-toJSON.nix new file mode 100644 index 0000000..8112e1c --- /dev/null +++ b/test/testdata/eval-fail-toJSON.nix | |||
@@ -0,0 +1,10 @@ | |||
1 | builtins.toJSON { | ||
2 | a.b = [ | ||
3 | true | ||
4 | false | ||
5 | "it's a bird" | ||
6 | { | ||
7 | c.d = throw "hah no"; | ||
8 | } | ||
9 | ]; | ||
10 | } | ||
diff --git a/test/testdata/eval-fail-undeclared-arg.err.exp b/test/testdata/eval-fail-undeclared-arg.err.exp new file mode 100644 index 0000000..6e13a13 --- /dev/null +++ b/test/testdata/eval-fail-undeclared-arg.err.exp | |||
@@ -0,0 +1,13 @@ | |||
1 | error: | ||
2 | … from call site | ||
3 | at /pwd/lang/eval-fail-undeclared-arg.nix:1:1: | ||
4 | 1| ({x, z}: x + z) {x = "foo"; y = "bla"; z = "bar";} | ||
5 | | ^ | ||
6 | 2| | ||
7 | |||
8 | error: function 'anonymous lambda' called with unexpected argument 'y' | ||
9 | at /pwd/lang/eval-fail-undeclared-arg.nix:1:2: | ||
10 | 1| ({x, z}: x + z) {x = "foo"; y = "bla"; z = "bar";} | ||
11 | | ^ | ||
12 | 2| | ||
13 | Did you mean one of x or z? | ||
diff --git a/test/testdata/eval-fail-undeclared-arg.nix b/test/testdata/eval-fail-undeclared-arg.nix new file mode 100644 index 0000000..cafdf16 --- /dev/null +++ b/test/testdata/eval-fail-undeclared-arg.nix | |||
@@ -0,0 +1 @@ | |||
({x, z}: x + z) {x = "foo"; y = "bla"; z = "bar";} | |||
diff --git a/test/testdata/eval-fail-using-set-as-attr-name.err.exp b/test/testdata/eval-fail-using-set-as-attr-name.err.exp new file mode 100644 index 0000000..4326c96 --- /dev/null +++ b/test/testdata/eval-fail-using-set-as-attr-name.err.exp | |||
@@ -0,0 +1,14 @@ | |||
1 | error: | ||
2 | … while evaluating an attribute name | ||
3 | at /pwd/lang/eval-fail-using-set-as-attr-name.nix:5:10: | ||
4 | 4| in | ||
5 | 5| attr.${key} | ||
6 | | ^ | ||
7 | 6| | ||
8 | |||
9 | error: expected a string but found a set: { } | ||
10 | at /pwd/lang/eval-fail-using-set-as-attr-name.nix:5:10: | ||
11 | 4| in | ||
12 | 5| attr.${key} | ||
13 | | ^ | ||
14 | 6| | ||
diff --git a/test/testdata/eval-fail-using-set-as-attr-name.nix b/test/testdata/eval-fail-using-set-as-attr-name.nix new file mode 100644 index 0000000..48e071a --- /dev/null +++ b/test/testdata/eval-fail-using-set-as-attr-name.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | let | ||
2 | attr = {foo = "bar";}; | ||
3 | key = {}; | ||
4 | in | ||
5 | attr.${key} | ||
diff --git a/test/testdata/eval-okay-any-all.exp b/test/testdata/eval-okay-any-all.exp new file mode 100644 index 0000000..eb273f4 --- /dev/null +++ b/test/testdata/eval-okay-any-all.exp | |||
@@ -0,0 +1 @@ | |||
[ false false true true true true false true ] | |||
diff --git a/test/testdata/eval-okay-any-all.nix b/test/testdata/eval-okay-any-all.nix new file mode 100644 index 0000000..a3f26ea --- /dev/null +++ b/test/testdata/eval-okay-any-all.nix | |||
@@ -0,0 +1,11 @@ | |||
1 | with builtins; | ||
2 | |||
3 | [ (any (x: x == 1) []) | ||
4 | (any (x: x == 1) [2 3 4]) | ||
5 | (any (x: x == 1) [1 2 3 4]) | ||
6 | (any (x: x == 1) [4 3 2 1]) | ||
7 | (all (x: x == 1) []) | ||
8 | (all (x: x == 1) [1]) | ||
9 | (all (x: x == 1) [1 2 3]) | ||
10 | (all (x: x == 1) [1 1 1]) | ||
11 | ] | ||
diff --git a/test/testdata/eval-okay-arithmetic.exp b/test/testdata/eval-okay-arithmetic.exp new file mode 100644 index 0000000..5c54d10 --- /dev/null +++ b/test/testdata/eval-okay-arithmetic.exp | |||
@@ -0,0 +1 @@ | |||
2216 | |||
diff --git a/test/testdata/eval-okay-arithmetic.nix b/test/testdata/eval-okay-arithmetic.nix new file mode 100644 index 0000000..7e9e6a0 --- /dev/null +++ b/test/testdata/eval-okay-arithmetic.nix | |||
@@ -0,0 +1,59 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | let { | ||
4 | |||
5 | /* Supposedly tail recursive version: | ||
6 | |||
7 | range_ = accum: first: last: | ||
8 | if first == last then ([first] ++ accum) | ||
9 | else range_ ([first] ++ accum) (builtins.add first 1) last; | ||
10 | |||
11 | range = range_ []; | ||
12 | */ | ||
13 | |||
14 | x = 12; | ||
15 | |||
16 | err = abort "urgh"; | ||
17 | |||
18 | body = sum | ||
19 | [ (sum (range 1 50)) | ||
20 | (123 + 456) | ||
21 | (0 + -10 + -(-11) + -x) | ||
22 | (10 - 7 - -2) | ||
23 | (10 - (6 - -1)) | ||
24 | (10 - 1 + 2) | ||
25 | (3 * 4 * 5) | ||
26 | (56088 / 123 / 2) | ||
27 | (3 + 4 * const 5 0 - 6 / id 2) | ||
28 | |||
29 | (builtins.bitAnd 12 10) # 0b1100 & 0b1010 = 8 | ||
30 | (builtins.bitOr 12 10) # 0b1100 | 0b1010 = 14 | ||
31 | (builtins.bitXor 12 10) # 0b1100 ^ 0b1010 = 6 | ||
32 | |||
33 | (if 3 < 7 then 1 else err) | ||
34 | (if 7 < 3 then err else 1) | ||
35 | (if 3 < 3 then err else 1) | ||
36 | |||
37 | (if 3 <= 7 then 1 else err) | ||
38 | (if 7 <= 3 then err else 1) | ||
39 | (if 3 <= 3 then 1 else err) | ||
40 | |||
41 | (if 3 > 7 then err else 1) | ||
42 | (if 7 > 3 then 1 else err) | ||
43 | (if 3 > 3 then err else 1) | ||
44 | |||
45 | (if 3 >= 7 then err else 1) | ||
46 | (if 7 >= 3 then 1 else err) | ||
47 | (if 3 >= 3 then 1 else err) | ||
48 | |||
49 | (if 2 > 1 == 1 < 2 then 1 else err) | ||
50 | (if 1 + 2 * 3 >= 7 then 1 else err) | ||
51 | (if 1 + 2 * 3 < 7 then err else 1) | ||
52 | |||
53 | # Not integer, but so what. | ||
54 | (if "aa" < "ab" then 1 else err) | ||
55 | (if "aa" < "aa" then err else 1) | ||
56 | (if "foo" < "foobar" then 1 else err) | ||
57 | ]; | ||
58 | |||
59 | } | ||
diff --git a/test/testdata/eval-okay-attrnames.exp b/test/testdata/eval-okay-attrnames.exp new file mode 100644 index 0000000..b4aa387 --- /dev/null +++ b/test/testdata/eval-okay-attrnames.exp | |||
@@ -0,0 +1 @@ | |||
"newxfoonewxy" | |||
diff --git a/test/testdata/eval-okay-attrnames.nix b/test/testdata/eval-okay-attrnames.nix new file mode 100644 index 0000000..e5b26e9 --- /dev/null +++ b/test/testdata/eval-okay-attrnames.nix | |||
@@ -0,0 +1,11 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | let | ||
4 | |||
5 | attrs = {y = "y"; x = "x"; foo = "foo";} // rec {x = "newx"; bar = x;}; | ||
6 | |||
7 | names = builtins.attrNames attrs; | ||
8 | |||
9 | values = map (name: builtins.getAttr name attrs) names; | ||
10 | |||
11 | in assert values == builtins.attrValues attrs; concat values | ||
diff --git a/test/testdata/eval-okay-attrs.exp b/test/testdata/eval-okay-attrs.exp new file mode 100644 index 0000000..45b0f82 --- /dev/null +++ b/test/testdata/eval-okay-attrs.exp | |||
@@ -0,0 +1 @@ | |||
987 | |||
diff --git a/test/testdata/eval-okay-attrs.nix b/test/testdata/eval-okay-attrs.nix new file mode 100644 index 0000000..810b31a --- /dev/null +++ b/test/testdata/eval-okay-attrs.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | let { | ||
2 | as = { x = 123; y = 456; } // { z = 789; } // { z = 987; }; | ||
3 | |||
4 | body = if as ? a then as.a else assert as ? z; as.z; | ||
5 | } | ||
diff --git a/test/testdata/eval-okay-attrs2.exp b/test/testdata/eval-okay-attrs2.exp new file mode 100644 index 0000000..45b0f82 --- /dev/null +++ b/test/testdata/eval-okay-attrs2.exp | |||
@@ -0,0 +1 @@ | |||
987 | |||
diff --git a/test/testdata/eval-okay-attrs2.nix b/test/testdata/eval-okay-attrs2.nix new file mode 100644 index 0000000..9e06b83 --- /dev/null +++ b/test/testdata/eval-okay-attrs2.nix | |||
@@ -0,0 +1,10 @@ | |||
1 | let { | ||
2 | as = { x = 123; y = 456; } // { z = 789; } // { z = 987; }; | ||
3 | |||
4 | A = "a"; | ||
5 | Z = "z"; | ||
6 | |||
7 | body = if builtins.hasAttr A as | ||
8 | then builtins.getAttr A as | ||
9 | else assert builtins.hasAttr Z as; builtins.getAttr Z as; | ||
10 | } | ||
diff --git a/test/testdata/eval-okay-attrs3.exp b/test/testdata/eval-okay-attrs3.exp new file mode 100644 index 0000000..19de4fd --- /dev/null +++ b/test/testdata/eval-okay-attrs3.exp | |||
@@ -0,0 +1 @@ | |||
"foo 22 80 itchyxac" | |||
diff --git a/test/testdata/eval-okay-attrs3.nix b/test/testdata/eval-okay-attrs3.nix new file mode 100644 index 0000000..f29de11 --- /dev/null +++ b/test/testdata/eval-okay-attrs3.nix | |||
@@ -0,0 +1,22 @@ | |||
1 | let | ||
2 | |||
3 | config = | ||
4 | { | ||
5 | services.sshd.enable = true; | ||
6 | services.sshd.port = 22; | ||
7 | services.httpd.port = 80; | ||
8 | hostName = "itchy"; | ||
9 | a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z = "x"; | ||
10 | foo = { | ||
11 | a = "a"; | ||
12 | b.c = "c"; | ||
13 | }; | ||
14 | }; | ||
15 | |||
16 | in | ||
17 | if config.services.sshd.enable | ||
18 | then "foo ${toString config.services.sshd.port} ${toString config.services.httpd.port} ${config.hostName}" | ||
19 | + "${config.a.b.c.d.e.f.g.h.i.j.k.l.m.n.o.p.q.r.s.t.u.v.w.x.y.z}" | ||
20 | + "${config.foo.a}" | ||
21 | + "${config.foo.b.c}" | ||
22 | else "bar" | ||
diff --git a/test/testdata/eval-okay-attrs4.exp b/test/testdata/eval-okay-attrs4.exp new file mode 100644 index 0000000..1851731 --- /dev/null +++ b/test/testdata/eval-okay-attrs4.exp | |||
@@ -0,0 +1 @@ | |||
[ true false true false false true false false ] | |||
diff --git a/test/testdata/eval-okay-attrs4.nix b/test/testdata/eval-okay-attrs4.nix new file mode 100644 index 0000000..43ec812 --- /dev/null +++ b/test/testdata/eval-okay-attrs4.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | let | ||
2 | |||
3 | as = { x.y.z = 123; a.b.c = 456; }; | ||
4 | |||
5 | bs = null; | ||
6 | |||
7 | in [ (as ? x) (as ? y) (as ? x.y.z) (as ? x.y.z.a) (as ? x.y.a) (as ? a.b.c) (bs ? x) (bs ? x.y.z) ] | ||
diff --git a/test/testdata/eval-okay-attrs5.exp b/test/testdata/eval-okay-attrs5.exp new file mode 100644 index 0000000..ce0430d --- /dev/null +++ b/test/testdata/eval-okay-attrs5.exp | |||
@@ -0,0 +1 @@ | |||
[ 123 "foo" 456 456 "foo" "xyzzy" "xyzzy" true ] | |||
diff --git a/test/testdata/eval-okay-attrs5.nix b/test/testdata/eval-okay-attrs5.nix new file mode 100644 index 0000000..a4584cd --- /dev/null +++ b/test/testdata/eval-okay-attrs5.nix | |||
@@ -0,0 +1,21 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | let | ||
4 | |||
5 | as = { x.y.z = 123; a.b.c = 456; }; | ||
6 | |||
7 | bs = { f-o-o.bar = "foo"; }; | ||
8 | |||
9 | or = x: y: x || y; | ||
10 | |||
11 | in | ||
12 | [ as.x.y.z | ||
13 | as.foo or "foo" | ||
14 | as.x.y.bla or as.a.b.c | ||
15 | as.a.b.c or as.x.y.z | ||
16 | as.x.y.bla or bs.f-o-o.bar or "xyzzy" | ||
17 | as.x.y.bla or bs.bar.foo or "xyzzy" | ||
18 | (123).bla or null.foo or "xyzzy" | ||
19 | # Backwards compatibility test. | ||
20 | (fold or [] [true false false]) | ||
21 | ] | ||
diff --git a/test/testdata/eval-okay-attrs6.exp b/test/testdata/eval-okay-attrs6.exp new file mode 100644 index 0000000..b469380 --- /dev/null +++ b/test/testdata/eval-okay-attrs6.exp | |||
@@ -0,0 +1 @@ | |||
{ __overrides = { bar = "qux"; }; bar = "qux"; foo = "bar"; } | |||
diff --git a/test/testdata/eval-okay-attrs6.nix b/test/testdata/eval-okay-attrs6.nix new file mode 100644 index 0000000..2e5c854 --- /dev/null +++ b/test/testdata/eval-okay-attrs6.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | rec { | ||
2 | "${"foo"}" = "bar"; | ||
3 | __overrides = { bar = "qux"; }; | ||
4 | } | ||
diff --git a/test/testdata/eval-okay-autoargs.exp b/test/testdata/eval-okay-autoargs.exp new file mode 100644 index 0000000..7a83917 --- /dev/null +++ b/test/testdata/eval-okay-autoargs.exp | |||
@@ -0,0 +1 @@ | |||
"xyzzy!xyzzy!foobar" | |||
diff --git a/test/testdata/eval-okay-autoargs.flags b/test/testdata/eval-okay-autoargs.flags new file mode 100644 index 0000000..ae37622 --- /dev/null +++ b/test/testdata/eval-okay-autoargs.flags | |||
@@ -0,0 +1 @@ | |||
--arg lib import(lang/lib.nix) --argstr xyzzy xyzzy! -A result | |||
diff --git a/test/testdata/eval-okay-autoargs.nix b/test/testdata/eval-okay-autoargs.nix new file mode 100644 index 0000000..815f51b --- /dev/null +++ b/test/testdata/eval-okay-autoargs.nix | |||
@@ -0,0 +1,15 @@ | |||
1 | let | ||
2 | |||
3 | foobar = "foobar"; | ||
4 | |||
5 | in | ||
6 | |||
7 | { xyzzy2 ? xyzzy # mutually recursive args | ||
8 | , xyzzy ? "blaat" # will be overridden by --argstr | ||
9 | , fb ? foobar | ||
10 | , lib # will be set by --arg | ||
11 | }: | ||
12 | |||
13 | { | ||
14 | result = lib.concat [xyzzy xyzzy2 fb]; | ||
15 | } | ||
diff --git a/test/testdata/eval-okay-backslash-newline-1.exp b/test/testdata/eval-okay-backslash-newline-1.exp new file mode 100644 index 0000000..3e75436 --- /dev/null +++ b/test/testdata/eval-okay-backslash-newline-1.exp | |||
@@ -0,0 +1 @@ | |||
"a\nb" | |||
diff --git a/test/testdata/eval-okay-backslash-newline-1.nix b/test/testdata/eval-okay-backslash-newline-1.nix new file mode 100644 index 0000000..7fef3dd --- /dev/null +++ b/test/testdata/eval-okay-backslash-newline-1.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | "a\ | ||
2 | b" | ||
diff --git a/test/testdata/eval-okay-backslash-newline-2.exp b/test/testdata/eval-okay-backslash-newline-2.exp new file mode 100644 index 0000000..3e75436 --- /dev/null +++ b/test/testdata/eval-okay-backslash-newline-2.exp | |||
@@ -0,0 +1 @@ | |||
"a\nb" | |||
diff --git a/test/testdata/eval-okay-backslash-newline-2.nix b/test/testdata/eval-okay-backslash-newline-2.nix new file mode 100644 index 0000000..35ddf49 --- /dev/null +++ b/test/testdata/eval-okay-backslash-newline-2.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | ''a''\ | ||
2 | b'' | ||
diff --git a/test/testdata/eval-okay-baseNameOf.exp b/test/testdata/eval-okay-baseNameOf.exp new file mode 100644 index 0000000..52c33a5 --- /dev/null +++ b/test/testdata/eval-okay-baseNameOf.exp | |||
@@ -0,0 +1 @@ | |||
"ok" | |||
diff --git a/test/testdata/eval-okay-baseNameOf.nix b/test/testdata/eval-okay-baseNameOf.nix new file mode 100644 index 0000000..a7afdd8 --- /dev/null +++ b/test/testdata/eval-okay-baseNameOf.nix | |||
@@ -0,0 +1,32 @@ | |||
1 | assert baseNameOf "" == ""; | ||
2 | assert baseNameOf "." == "."; | ||
3 | assert baseNameOf ".." == ".."; | ||
4 | assert baseNameOf "a" == "a"; | ||
5 | assert baseNameOf "a." == "a."; | ||
6 | assert baseNameOf "a.." == "a.."; | ||
7 | assert baseNameOf "a.b" == "a.b"; | ||
8 | assert baseNameOf "a.b." == "a.b."; | ||
9 | assert baseNameOf "a.b.." == "a.b.."; | ||
10 | assert baseNameOf "a/" == "a"; | ||
11 | assert baseNameOf "a/." == "."; | ||
12 | assert baseNameOf "a/.." == ".."; | ||
13 | assert baseNameOf "a/b" == "b"; | ||
14 | assert baseNameOf "a/b." == "b."; | ||
15 | assert baseNameOf "a/b.." == "b.."; | ||
16 | assert baseNameOf "a/b/c" == "c"; | ||
17 | assert baseNameOf "a/b/c." == "c."; | ||
18 | assert baseNameOf "a/b/c.." == "c.."; | ||
19 | assert baseNameOf "a/b/c/d" == "d"; | ||
20 | assert baseNameOf "a/b/c/d." == "d."; | ||
21 | assert baseNameOf "a\\b" == "a\\b"; | ||
22 | assert baseNameOf "C:a" == "C:a"; | ||
23 | assert baseNameOf "a//b" == "b"; | ||
24 | |||
25 | # It's been like this for close to a decade. We ought to commit to it. | ||
26 | # https://github.com/NixOS/nix/pull/582#issuecomment-121014450 | ||
27 | assert baseNameOf "a//" == ""; | ||
28 | |||
29 | assert baseNameOf ./foo == "foo"; | ||
30 | assert baseNameOf ./foo/bar == "bar"; | ||
31 | |||
32 | "ok" | ||
diff --git a/test/testdata/eval-okay-builtins-add.exp b/test/testdata/eval-okay-builtins-add.exp new file mode 100644 index 0000000..0350b51 --- /dev/null +++ b/test/testdata/eval-okay-builtins-add.exp | |||
@@ -0,0 +1 @@ | |||
[ 5 4 "int" "tt" "float" 4 ] | |||
diff --git a/test/testdata/eval-okay-builtins-add.nix b/test/testdata/eval-okay-builtins-add.nix new file mode 100644 index 0000000..c841816 --- /dev/null +++ b/test/testdata/eval-okay-builtins-add.nix | |||
@@ -0,0 +1,8 @@ | |||
1 | [ | ||
2 | (builtins.add 2 3) | ||
3 | (builtins.add 2 2) | ||
4 | (builtins.typeOf (builtins.add 2 2)) | ||
5 | ("t" + "t") | ||
6 | (builtins.typeOf (builtins.add 2.0 2)) | ||
7 | (builtins.add 2.0 2) | ||
8 | ] | ||
diff --git a/test/testdata/eval-okay-builtins.exp b/test/testdata/eval-okay-builtins.exp new file mode 100644 index 0000000..0661686 --- /dev/null +++ b/test/testdata/eval-okay-builtins.exp | |||
@@ -0,0 +1 @@ | |||
/foo | |||
diff --git a/test/testdata/eval-okay-builtins.nix b/test/testdata/eval-okay-builtins.nix new file mode 100644 index 0000000..e9d65e8 --- /dev/null +++ b/test/testdata/eval-okay-builtins.nix | |||
@@ -0,0 +1,12 @@ | |||
1 | assert builtins ? currentSystem; | ||
2 | assert !builtins ? __currentSystem; | ||
3 | |||
4 | let { | ||
5 | |||
6 | x = if builtins ? dirOf then builtins.dirOf /foo/bar else ""; | ||
7 | |||
8 | y = if builtins ? fnord then builtins.fnord "foo" else ""; | ||
9 | |||
10 | body = x + y; | ||
11 | |||
12 | } | ||
diff --git a/test/testdata/eval-okay-callable-attrs.exp b/test/testdata/eval-okay-callable-attrs.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-callable-attrs.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-callable-attrs.nix b/test/testdata/eval-okay-callable-attrs.nix new file mode 100644 index 0000000..310a030 --- /dev/null +++ b/test/testdata/eval-okay-callable-attrs.nix | |||
@@ -0,0 +1 @@ | |||
({ __functor = self: x: self.foo && x; foo = false; } // { foo = true; }) true | |||
diff --git a/test/testdata/eval-okay-catattrs.exp b/test/testdata/eval-okay-catattrs.exp new file mode 100644 index 0000000..b4a1e66 --- /dev/null +++ b/test/testdata/eval-okay-catattrs.exp | |||
@@ -0,0 +1 @@ | |||
[ 1 2 ] | |||
diff --git a/test/testdata/eval-okay-catattrs.nix b/test/testdata/eval-okay-catattrs.nix new file mode 100644 index 0000000..2c3dc10 --- /dev/null +++ b/test/testdata/eval-okay-catattrs.nix | |||
@@ -0,0 +1 @@ | |||
builtins.catAttrs "a" [ { a = 1; } { b = 0; } { a = 2; } ] | |||
diff --git a/test/testdata/eval-okay-closure.exp b/test/testdata/eval-okay-closure.exp new file mode 100644 index 0000000..e7dbf97 --- /dev/null +++ b/test/testdata/eval-okay-closure.exp | |||
@@ -0,0 +1 @@ | |||
[ { foo = true; key = -13; } { foo = true; key = -12; } { foo = true; key = -11; } { foo = true; key = -9; } { foo = true; key = -8; } { foo = true; key = -7; } { foo = true; key = -5; } { foo = true; key = -4; } { foo = true; key = -3; } { key = -1; } { foo = true; key = 0; } { foo = true; key = 1; } { foo = true; key = 2; } { foo = true; key = 4; } { foo = true; key = 5; } { foo = true; key = 6; } { key = 8; } { foo = true; key = 9; } { foo = true; key = 10; } { foo = true; key = 13; } { foo = true; key = 14; } { foo = true; key = 15; } { key = 17; } { foo = true; key = 18; } { foo = true; key = 19; } { foo = true; key = 22; } { foo = true; key = 23; } { key = 26; } { foo = true; key = 27; } { foo = true; key = 28; } { foo = true; key = 31; } { foo = true; key = 32; } { key = 35; } { foo = true; key = 36; } { foo = true; key = 40; } { foo = true; key = 41; } { key = 44; } { foo = true; key = 45; } { foo = true; key = 49; } { key = 53; } { foo = true; key = 54; } { foo = true; key = 58; } { key = 62; } { foo = true; key = 67; } { key = 71; } { key = 80; } ] | |||
diff --git a/test/testdata/eval-okay-closure.exp.xml b/test/testdata/eval-okay-closure.exp.xml new file mode 100644 index 0000000..dffc03a --- /dev/null +++ b/test/testdata/eval-okay-closure.exp.xml | |||
@@ -0,0 +1,343 @@ | |||
1 | <?xml version='1.0' encoding='utf-8'?> | ||
2 | <expr> | ||
3 | <list> | ||
4 | <attrs> | ||
5 | <attr name="foo"> | ||
6 | <bool value="true" /> | ||
7 | </attr> | ||
8 | <attr name="key"> | ||
9 | <int value="-13" /> | ||
10 | </attr> | ||
11 | </attrs> | ||
12 | <attrs> | ||
13 | <attr name="foo"> | ||
14 | <bool value="true" /> | ||
15 | </attr> | ||
16 | <attr name="key"> | ||
17 | <int value="-12" /> | ||
18 | </attr> | ||
19 | </attrs> | ||
20 | <attrs> | ||
21 | <attr name="foo"> | ||
22 | <bool value="true" /> | ||
23 | </attr> | ||
24 | <attr name="key"> | ||
25 | <int value="-11" /> | ||
26 | </attr> | ||
27 | </attrs> | ||
28 | <attrs> | ||
29 | <attr name="foo"> | ||
30 | <bool value="true" /> | ||
31 | </attr> | ||
32 | <attr name="key"> | ||
33 | <int value="-9" /> | ||
34 | </attr> | ||
35 | </attrs> | ||
36 | <attrs> | ||
37 | <attr name="foo"> | ||
38 | <bool value="true" /> | ||
39 | </attr> | ||
40 | <attr name="key"> | ||
41 | <int value="-8" /> | ||
42 | </attr> | ||
43 | </attrs> | ||
44 | <attrs> | ||
45 | <attr name="foo"> | ||
46 | <bool value="true" /> | ||
47 | </attr> | ||
48 | <attr name="key"> | ||
49 | <int value="-7" /> | ||
50 | </attr> | ||
51 | </attrs> | ||
52 | <attrs> | ||
53 | <attr name="foo"> | ||
54 | <bool value="true" /> | ||
55 | </attr> | ||
56 | <attr name="key"> | ||
57 | <int value="-5" /> | ||
58 | </attr> | ||
59 | </attrs> | ||
60 | <attrs> | ||
61 | <attr name="foo"> | ||
62 | <bool value="true" /> | ||
63 | </attr> | ||
64 | <attr name="key"> | ||
65 | <int value="-4" /> | ||
66 | </attr> | ||
67 | </attrs> | ||
68 | <attrs> | ||
69 | <attr name="foo"> | ||
70 | <bool value="true" /> | ||
71 | </attr> | ||
72 | <attr name="key"> | ||
73 | <int value="-3" /> | ||
74 | </attr> | ||
75 | </attrs> | ||
76 | <attrs> | ||
77 | <attr name="key"> | ||
78 | <int value="-1" /> | ||
79 | </attr> | ||
80 | </attrs> | ||
81 | <attrs> | ||
82 | <attr name="foo"> | ||
83 | <bool value="true" /> | ||
84 | </attr> | ||
85 | <attr name="key"> | ||
86 | <int value="0" /> | ||
87 | </attr> | ||
88 | </attrs> | ||
89 | <attrs> | ||
90 | <attr name="foo"> | ||
91 | <bool value="true" /> | ||
92 | </attr> | ||
93 | <attr name="key"> | ||
94 | <int value="1" /> | ||
95 | </attr> | ||
96 | </attrs> | ||
97 | <attrs> | ||
98 | <attr name="foo"> | ||
99 | <bool value="true" /> | ||
100 | </attr> | ||
101 | <attr name="key"> | ||
102 | <int value="2" /> | ||
103 | </attr> | ||
104 | </attrs> | ||
105 | <attrs> | ||
106 | <attr name="foo"> | ||
107 | <bool value="true" /> | ||
108 | </attr> | ||
109 | <attr name="key"> | ||
110 | <int value="4" /> | ||
111 | </attr> | ||
112 | </attrs> | ||
113 | <attrs> | ||
114 | <attr name="foo"> | ||
115 | <bool value="true" /> | ||
116 | </attr> | ||
117 | <attr name="key"> | ||
118 | <int value="5" /> | ||
119 | </attr> | ||
120 | </attrs> | ||
121 | <attrs> | ||
122 | <attr name="foo"> | ||
123 | <bool value="true" /> | ||
124 | </attr> | ||
125 | <attr name="key"> | ||
126 | <int value="6" /> | ||
127 | </attr> | ||
128 | </attrs> | ||
129 | <attrs> | ||
130 | <attr name="key"> | ||
131 | <int value="8" /> | ||
132 | </attr> | ||
133 | </attrs> | ||
134 | <attrs> | ||
135 | <attr name="foo"> | ||
136 | <bool value="true" /> | ||
137 | </attr> | ||
138 | <attr name="key"> | ||
139 | <int value="9" /> | ||
140 | </attr> | ||
141 | </attrs> | ||
142 | <attrs> | ||
143 | <attr name="foo"> | ||
144 | <bool value="true" /> | ||
145 | </attr> | ||
146 | <attr name="key"> | ||
147 | <int value="10" /> | ||
148 | </attr> | ||
149 | </attrs> | ||
150 | <attrs> | ||
151 | <attr name="foo"> | ||
152 | <bool value="true" /> | ||
153 | </attr> | ||
154 | <attr name="key"> | ||
155 | <int value="13" /> | ||
156 | </attr> | ||
157 | </attrs> | ||
158 | <attrs> | ||
159 | <attr name="foo"> | ||
160 | <bool value="true" /> | ||
161 | </attr> | ||
162 | <attr name="key"> | ||
163 | <int value="14" /> | ||
164 | </attr> | ||
165 | </attrs> | ||
166 | <attrs> | ||
167 | <attr name="foo"> | ||
168 | <bool value="true" /> | ||
169 | </attr> | ||
170 | <attr name="key"> | ||
171 | <int value="15" /> | ||
172 | </attr> | ||
173 | </attrs> | ||
174 | <attrs> | ||
175 | <attr name="key"> | ||
176 | <int value="17" /> | ||
177 | </attr> | ||
178 | </attrs> | ||
179 | <attrs> | ||
180 | <attr name="foo"> | ||
181 | <bool value="true" /> | ||
182 | </attr> | ||
183 | <attr name="key"> | ||
184 | <int value="18" /> | ||
185 | </attr> | ||
186 | </attrs> | ||
187 | <attrs> | ||
188 | <attr name="foo"> | ||
189 | <bool value="true" /> | ||
190 | </attr> | ||
191 | <attr name="key"> | ||
192 | <int value="19" /> | ||
193 | </attr> | ||
194 | </attrs> | ||
195 | <attrs> | ||
196 | <attr name="foo"> | ||
197 | <bool value="true" /> | ||
198 | </attr> | ||
199 | <attr name="key"> | ||
200 | <int value="22" /> | ||
201 | </attr> | ||
202 | </attrs> | ||
203 | <attrs> | ||
204 | <attr name="foo"> | ||
205 | <bool value="true" /> | ||
206 | </attr> | ||
207 | <attr name="key"> | ||
208 | <int value="23" /> | ||
209 | </attr> | ||
210 | </attrs> | ||
211 | <attrs> | ||
212 | <attr name="key"> | ||
213 | <int value="26" /> | ||
214 | </attr> | ||
215 | </attrs> | ||
216 | <attrs> | ||
217 | <attr name="foo"> | ||
218 | <bool value="true" /> | ||
219 | </attr> | ||
220 | <attr name="key"> | ||
221 | <int value="27" /> | ||
222 | </attr> | ||
223 | </attrs> | ||
224 | <attrs> | ||
225 | <attr name="foo"> | ||
226 | <bool value="true" /> | ||
227 | </attr> | ||
228 | <attr name="key"> | ||
229 | <int value="28" /> | ||
230 | </attr> | ||
231 | </attrs> | ||
232 | <attrs> | ||
233 | <attr name="foo"> | ||
234 | <bool value="true" /> | ||
235 | </attr> | ||
236 | <attr name="key"> | ||
237 | <int value="31" /> | ||
238 | </attr> | ||
239 | </attrs> | ||
240 | <attrs> | ||
241 | <attr name="foo"> | ||
242 | <bool value="true" /> | ||
243 | </attr> | ||
244 | <attr name="key"> | ||
245 | <int value="32" /> | ||
246 | </attr> | ||
247 | </attrs> | ||
248 | <attrs> | ||
249 | <attr name="key"> | ||
250 | <int value="35" /> | ||
251 | </attr> | ||
252 | </attrs> | ||
253 | <attrs> | ||
254 | <attr name="foo"> | ||
255 | <bool value="true" /> | ||
256 | </attr> | ||
257 | <attr name="key"> | ||
258 | <int value="36" /> | ||
259 | </attr> | ||
260 | </attrs> | ||
261 | <attrs> | ||
262 | <attr name="foo"> | ||
263 | <bool value="true" /> | ||
264 | </attr> | ||
265 | <attr name="key"> | ||
266 | <int value="40" /> | ||
267 | </attr> | ||
268 | </attrs> | ||
269 | <attrs> | ||
270 | <attr name="foo"> | ||
271 | <bool value="true" /> | ||
272 | </attr> | ||
273 | <attr name="key"> | ||
274 | <int value="41" /> | ||
275 | </attr> | ||
276 | </attrs> | ||
277 | <attrs> | ||
278 | <attr name="key"> | ||
279 | <int value="44" /> | ||
280 | </attr> | ||
281 | </attrs> | ||
282 | <attrs> | ||
283 | <attr name="foo"> | ||
284 | <bool value="true" /> | ||
285 | </attr> | ||
286 | <attr name="key"> | ||
287 | <int value="45" /> | ||
288 | </attr> | ||
289 | </attrs> | ||
290 | <attrs> | ||
291 | <attr name="foo"> | ||
292 | <bool value="true" /> | ||
293 | </attr> | ||
294 | <attr name="key"> | ||
295 | <int value="49" /> | ||
296 | </attr> | ||
297 | </attrs> | ||
298 | <attrs> | ||
299 | <attr name="key"> | ||
300 | <int value="53" /> | ||
301 | </attr> | ||
302 | </attrs> | ||
303 | <attrs> | ||
304 | <attr name="foo"> | ||
305 | <bool value="true" /> | ||
306 | </attr> | ||
307 | <attr name="key"> | ||
308 | <int value="54" /> | ||
309 | </attr> | ||
310 | </attrs> | ||
311 | <attrs> | ||
312 | <attr name="foo"> | ||
313 | <bool value="true" /> | ||
314 | </attr> | ||
315 | <attr name="key"> | ||
316 | <int value="58" /> | ||
317 | </attr> | ||
318 | </attrs> | ||
319 | <attrs> | ||
320 | <attr name="key"> | ||
321 | <int value="62" /> | ||
322 | </attr> | ||
323 | </attrs> | ||
324 | <attrs> | ||
325 | <attr name="foo"> | ||
326 | <bool value="true" /> | ||
327 | </attr> | ||
328 | <attr name="key"> | ||
329 | <int value="67" /> | ||
330 | </attr> | ||
331 | </attrs> | ||
332 | <attrs> | ||
333 | <attr name="key"> | ||
334 | <int value="71" /> | ||
335 | </attr> | ||
336 | </attrs> | ||
337 | <attrs> | ||
338 | <attr name="key"> | ||
339 | <int value="80" /> | ||
340 | </attr> | ||
341 | </attrs> | ||
342 | </list> | ||
343 | </expr> | ||
diff --git a/test/testdata/eval-okay-closure.nix b/test/testdata/eval-okay-closure.nix new file mode 100644 index 0000000..cccd4dc --- /dev/null +++ b/test/testdata/eval-okay-closure.nix | |||
@@ -0,0 +1,13 @@ | |||
1 | let | ||
2 | |||
3 | closure = builtins.genericClosure { | ||
4 | startSet = [{key = 80;}]; | ||
5 | operator = {key, foo ? false}: | ||
6 | if builtins.lessThan key 0 | ||
7 | then [] | ||
8 | else [{key = builtins.sub key 9;} {key = builtins.sub key 13; foo = true;}]; | ||
9 | }; | ||
10 | |||
11 | sort = (import ./lib.nix).sortBy (a: b: builtins.lessThan a.key b.key); | ||
12 | |||
13 | in sort closure | ||
diff --git a/test/testdata/eval-okay-comments.exp b/test/testdata/eval-okay-comments.exp new file mode 100644 index 0000000..7182dc2 --- /dev/null +++ b/test/testdata/eval-okay-comments.exp | |||
@@ -0,0 +1 @@ | |||
"abcdefghijklmnopqrstuvwxyz" | |||
diff --git a/test/testdata/eval-okay-comments.nix b/test/testdata/eval-okay-comments.nix new file mode 100644 index 0000000..cb2cce2 --- /dev/null +++ b/test/testdata/eval-okay-comments.nix | |||
@@ -0,0 +1,59 @@ | |||
1 | # A simple comment | ||
2 | "a"+ # And another | ||
3 | ## A double comment | ||
4 | "b"+ ## And another | ||
5 | # Nested # comments # | ||
6 | "c"+ # and # some # other # | ||
7 | # An empty line, following here: | ||
8 | |||
9 | "d"+ # and a comment not starting the line ! | ||
10 | |||
11 | "e"+ | ||
12 | /* multiline comments */ | ||
13 | "f" + | ||
14 | /* multiline | ||
15 | comments, | ||
16 | on | ||
17 | multiple | ||
18 | lines | ||
19 | */ | ||
20 | "g" + | ||
21 | # Small, tricky comments | ||
22 | /**/ "h"+ /*/*/ "i"+ /***/ "j"+ /* /*/ "k"+ /*/* /*/ "l"+ | ||
23 | # Comments with an even number of ending '*' used to fail: | ||
24 | "m"+ | ||
25 | /* */ /* **/ /* ***/ /* ****/ "n"+ | ||
26 | /* */ /** */ /*** */ /**** */ "o"+ | ||
27 | /** **/ /*** ***/ /**** ****/ "p"+ | ||
28 | /* * ** *** **** ***** */ "q"+ | ||
29 | # Random comments | ||
30 | /* ***** ////// * / * / /* */ "r"+ | ||
31 | # Mixed comments | ||
32 | /* # */ | ||
33 | "s"+ | ||
34 | # /* # | ||
35 | "t"+ | ||
36 | # /* # */ | ||
37 | "u"+ | ||
38 | # /*********/ | ||
39 | "v"+ | ||
40 | ## */* | ||
41 | "w"+ | ||
42 | /* | ||
43 | * Multiline, decorated comments | ||
44 | * # This ain't a nest'd comm'nt | ||
45 | */ | ||
46 | "x"+ | ||
47 | ''${/** with **/"y" | ||
48 | # real | ||
49 | /* comments | ||
50 | inside ! # */ | ||
51 | |||
52 | # (and empty lines) | ||
53 | |||
54 | }''+ /* And a multiline comment, | ||
55 | on the same line, | ||
56 | after some spaces | ||
57 | */ # followed by a one-line comment | ||
58 | "z" | ||
59 | /* EOF */ | ||
diff --git a/test/testdata/eval-okay-concat.exp b/test/testdata/eval-okay-concat.exp new file mode 100644 index 0000000..bb4bbd5 --- /dev/null +++ b/test/testdata/eval-okay-concat.exp | |||
@@ -0,0 +1 @@ | |||
[ 1 2 3 4 5 6 7 8 9 ] | |||
diff --git a/test/testdata/eval-okay-concat.nix b/test/testdata/eval-okay-concat.nix new file mode 100644 index 0000000..d158a9b --- /dev/null +++ b/test/testdata/eval-okay-concat.nix | |||
@@ -0,0 +1 @@ | |||
[1 2 3] ++ [4 5 6] ++ [7 8 9] | |||
diff --git a/test/testdata/eval-okay-concatmap.exp b/test/testdata/eval-okay-concatmap.exp new file mode 100644 index 0000000..3b8be77 --- /dev/null +++ b/test/testdata/eval-okay-concatmap.exp | |||
@@ -0,0 +1 @@ | |||
[ [ 1 3 5 7 9 ] [ "a" "z" "b" "z" ] ] | |||
diff --git a/test/testdata/eval-okay-concatmap.nix b/test/testdata/eval-okay-concatmap.nix new file mode 100644 index 0000000..97da5d3 --- /dev/null +++ b/test/testdata/eval-okay-concatmap.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | [ (builtins.concatMap (x: if x / 2 * 2 == x then [] else [ x ]) (range 0 10)) | ||
4 | (builtins.concatMap (x: [x] ++ ["z"]) ["a" "b"]) | ||
5 | ] | ||
diff --git a/test/testdata/eval-okay-concatstringssep.exp b/test/testdata/eval-okay-concatstringssep.exp new file mode 100644 index 0000000..9398764 --- /dev/null +++ b/test/testdata/eval-okay-concatstringssep.exp | |||
@@ -0,0 +1 @@ | |||
[ "" "foobarxyzzy" "foo, bar, xyzzy" "foo" "" ] | |||
diff --git a/test/testdata/eval-okay-concatstringssep.nix b/test/testdata/eval-okay-concatstringssep.nix new file mode 100644 index 0000000..adc4c41 --- /dev/null +++ b/test/testdata/eval-okay-concatstringssep.nix | |||
@@ -0,0 +1,8 @@ | |||
1 | with builtins; | ||
2 | |||
3 | [ (concatStringsSep "" []) | ||
4 | (concatStringsSep "" ["foo" "bar" "xyzzy"]) | ||
5 | (concatStringsSep ", " ["foo" "bar" "xyzzy"]) | ||
6 | (concatStringsSep ", " ["foo"]) | ||
7 | (concatStringsSep ", " []) | ||
8 | ] | ||
diff --git a/test/testdata/eval-okay-context-introspection.exp b/test/testdata/eval-okay-context-introspection.exp new file mode 100644 index 0000000..a136b00 --- /dev/null +++ b/test/testdata/eval-okay-context-introspection.exp | |||
@@ -0,0 +1 @@ | |||
[ true true true true true true true true true true true true true ] | |||
diff --git a/test/testdata/eval-okay-context-introspection.nix b/test/testdata/eval-okay-context-introspection.nix new file mode 100644 index 0000000..8886cf3 --- /dev/null +++ b/test/testdata/eval-okay-context-introspection.nix | |||
@@ -0,0 +1,59 @@ | |||
1 | let | ||
2 | drv = derivation { | ||
3 | name = "fail"; | ||
4 | builder = "/bin/false"; | ||
5 | system = "x86_64-linux"; | ||
6 | outputs = [ "out" "foo" ]; | ||
7 | }; | ||
8 | |||
9 | path = "${./eval-okay-context-introspection.nix}"; | ||
10 | |||
11 | desired-context = { | ||
12 | "${builtins.unsafeDiscardStringContext path}" = { | ||
13 | path = true; | ||
14 | }; | ||
15 | "${builtins.unsafeDiscardStringContext drv.drvPath}" = { | ||
16 | outputs = [ "foo" "out" ]; | ||
17 | allOutputs = true; | ||
18 | }; | ||
19 | }; | ||
20 | |||
21 | combo-path = "${path}${drv.outPath}${drv.foo.outPath}${drv.drvPath}"; | ||
22 | legit-context = builtins.getContext combo-path; | ||
23 | |||
24 | reconstructed-path = builtins.appendContext | ||
25 | (builtins.unsafeDiscardStringContext combo-path) | ||
26 | desired-context; | ||
27 | |||
28 | # Eta rule for strings with context. | ||
29 | etaRule = str: | ||
30 | str == builtins.appendContext | ||
31 | (builtins.unsafeDiscardStringContext str) | ||
32 | (builtins.getContext str); | ||
33 | |||
34 | # Only holds true if string context contains both a `DrvDeep` and | ||
35 | # `Opaque` element. | ||
36 | almostEtaRule = str: | ||
37 | str == builtins.addDrvOutputDependencies | ||
38 | (builtins.unsafeDiscardOutputDependency str); | ||
39 | |||
40 | addDrvOutputDependencies_idempotent = str: | ||
41 | builtins.addDrvOutputDependencies str == | ||
42 | builtins.addDrvOutputDependencies (builtins.addDrvOutputDependencies str); | ||
43 | |||
44 | rules = str: [ | ||
45 | (etaRule str) | ||
46 | (almostEtaRule str) | ||
47 | (addDrvOutputDependencies_idempotent str) | ||
48 | ]; | ||
49 | |||
50 | in [ | ||
51 | (legit-context == desired-context) | ||
52 | (reconstructed-path == combo-path) | ||
53 | (etaRule "foo") | ||
54 | (etaRule drv.foo.outPath) | ||
55 | ] ++ builtins.concatMap rules [ | ||
56 | drv.drvPath | ||
57 | (builtins.addDrvOutputDependencies drv.drvPath) | ||
58 | (builtins.unsafeDiscardOutputDependency drv.drvPath) | ||
59 | ] | ||
diff --git a/test/testdata/eval-okay-context.exp b/test/testdata/eval-okay-context.exp new file mode 100644 index 0000000..2f535bd --- /dev/null +++ b/test/testdata/eval-okay-context.exp | |||
@@ -0,0 +1 @@ | |||
"foo eval-okay-context.nix bar" | |||
diff --git a/test/testdata/eval-okay-context.nix b/test/testdata/eval-okay-context.nix new file mode 100644 index 0000000..7b9531c --- /dev/null +++ b/test/testdata/eval-okay-context.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | let s = "foo ${builtins.substring 33 100 (baseNameOf "${./eval-okay-context.nix}")} bar"; | ||
2 | in | ||
3 | if s != "foo eval-okay-context.nix bar" | ||
4 | then abort "context not discarded" | ||
5 | else builtins.unsafeDiscardStringContext s | ||
6 | |||
diff --git a/test/testdata/eval-okay-convertHash.err.exp b/test/testdata/eval-okay-convertHash.err.exp new file mode 100644 index 0000000..41d7467 --- /dev/null +++ b/test/testdata/eval-okay-convertHash.err.exp | |||
@@ -0,0 +1,108 @@ | |||
1 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
2 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
3 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
4 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
5 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
6 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
7 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
8 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
9 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
10 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
11 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
12 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
13 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
14 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
15 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
16 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
17 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
18 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
19 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
20 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
21 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
22 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
23 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
24 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
25 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
26 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
27 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
28 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
29 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
30 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
31 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
32 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
33 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
34 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
35 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
36 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
37 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
38 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
39 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
40 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
41 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
42 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
43 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
44 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
45 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
46 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
47 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
48 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
49 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
50 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
51 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
52 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
53 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
54 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
55 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
56 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
57 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
58 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
59 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
60 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
61 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
62 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
63 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
64 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
65 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
66 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
67 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
68 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
69 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
70 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
71 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
72 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
73 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
74 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
75 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
76 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
77 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
78 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
79 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
80 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
81 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
82 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
83 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
84 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
85 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
86 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
87 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
88 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
89 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
90 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
91 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
92 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
93 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
94 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
95 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
96 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
97 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
98 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
99 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
100 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
101 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
102 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
103 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
104 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
105 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
106 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
107 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
108 | warning: "base32" is a deprecated alias for hash format "nix32". | ||
diff --git a/test/testdata/eval-okay-convertHash.exp b/test/testdata/eval-okay-convertHash.exp new file mode 100644 index 0000000..16b0240 --- /dev/null +++ b/test/testdata/eval-okay-convertHash.exp | |||
@@ -0,0 +1 @@ | |||
{ hashesBase16 = [ "d41d8cd98f00b204e9800998ecf8427e" "6c69ee7f211c640419d5366cc076ae46" "bb3438fbabd460ea6dbd27d153e2233b" "da39a3ee5e6b4b0d3255bfef95601890afd80709" "cd54e8568c1b37cf1e5badb0779bcbf382212189" "6d12e10b1d331dad210e47fd25d4f260802b7e77" "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" "900a4469df00ccbfd0c145c6d1e4b7953dd0afafadd7534e3a4019e8d38fc663" "ad0387b3bd8652f730ca46d25f9c170af0fd589f42e7f23f5a9e6412d97d7e56" "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" "9d0886f8c6b389398a16257bc79780fab9831c7fc11c8ab07fa732cb7b348feade382f92617c9c5305fefba0af02ab5fd39a587d330997ff5bd0db19f7666653" "21644b72aa259e5a588cd3afbafb1d4310f4889680f6c83b9d531596a5a284f34dbebff409d23bcc86aee6bad10c891606f075c6f4755cb536da27db5693f3a7" ]; hashesBase32 = [ "3y8bwfr609h3lh9ch0izcqq7fl" "26mrvc0v1nslch8r0w45zywsbc" "1v4gi57l97pmnylq6lmgxkhd5v" "143xibwh31h9bvxzalr0sjvbbvpa6ffs" "i4hj30pkrfdpgc5dbcgcydqviibfhm6d" "fxz2p030yba2bza71qhss79k3l5y24kd" "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73" "0qy6iz9yh6a079757mxdmypx0gcmnzjd3ij5q78bzk00vxll82lh" "0mkygpci4r4yb8zz5rs2kxcgvw0a2yf5zlj6r8qgfll6pnrqf0xd" "0zdl9zrg8r3i9c1g90lgg9ip5ijzv3yhz91i0zzn3r8ap9ws784gkp9dk9j3aglhgf1amqb0pj21mh7h1nxcl18akqvvf7ggqsy30yg" "19ncrpp37dx0nzzjw4k6zaqkb9mzaq2myhgpzh5aff7qqcj5wwdxslg6ixwncm7gyq8l761gwf87fgsh2bwfyr52s53k2dkqvw8c24x" "2kz74snvckxldmmbisz9ikmy031d28cs6xfdbl6rhxx42glpyz4vww4lajrc5akklxwixl0js4g84233pxvmbykiic5m7i5m9r4nr11" ]; hashesBase64 = [ "1B2M2Y8AsgTpgAmY7PhCfg==" "bGnufyEcZAQZ1TZswHauRg==" "uzQ4+6vUYOptvSfRU+IjOw==" "2jmj7l5rSw0yVb/vlWAYkK/YBwk=" "zVToVowbN88eW62wd5vL84IhIYk=" "bRLhCx0zHa0hDkf9JdTyYIArfnc=" "47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=" "kApEad8AzL/QwUXG0eS3lT3Qr6+t11NOOkAZ6NOPxmM=" "rQOHs72GUvcwykbSX5wXCvD9WJ9C5/I/Wp5kEtl9flY=" "z4PhNX7vuL3xVChQ1m2AB9Yg5AULVxXcg/SpIdNs6c5H0NE8XYXysP+DGNKHfuwvY7kxvUdBeoGlODJ6+SfaPg==" "nQiG+MaziTmKFiV7x5eA+rmDHH/BHIqwf6cyy3s0j+reOC+SYXycUwX++6CvAqtf05pYfTMJl/9b0NsZ92ZmUw==" "IWRLcqolnlpYjNOvuvsdQxD0iJaA9sg7nVMVlqWihPNNvr/0CdI7zIau5rrRDIkWBvB1xvR1XLU22ifbVpPzpw==" ]; hashesNix32 = [ "3y8bwfr609h3lh9ch0izcqq7fl" "26mrvc0v1nslch8r0w45zywsbc" "1v4gi57l97pmnylq6lmgxkhd5v" "143xibwh31h9bvxzalr0sjvbbvpa6ffs" "i4hj30pkrfdpgc5dbcgcydqviibfhm6d" "fxz2p030yba2bza71qhss79k3l5y24kd" "0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73" "0qy6iz9yh6a079757mxdmypx0gcmnzjd3ij5q78bzk00vxll82lh" "0mkygpci4r4yb8zz5rs2kxcgvw0a2yf5zlj6r8qgfll6pnrqf0xd" "0zdl9zrg8r3i9c1g90lgg9ip5ijzv3yhz91i0zzn3r8ap9ws784gkp9dk9j3aglhgf1amqb0pj21mh7h1nxcl18akqvvf7ggqsy30yg" "19ncrpp37dx0nzzjw4k6zaqkb9mzaq2myhgpzh5aff7qqcj5wwdxslg6ixwncm7gyq8l761gwf87fgsh2bwfyr52s53k2dkqvw8c24x" "2kz74snvckxldmmbisz9ikmy031d28cs6xfdbl6rhxx42glpyz4vww4lajrc5akklxwixl0js4g84233pxvmbykiic5m7i5m9r4nr11" ]; hashesSRI = [ "md5-1B2M2Y8AsgTpgAmY7PhCfg==" "md5-bGnufyEcZAQZ1TZswHauRg==" "md5-uzQ4+6vUYOptvSfRU+IjOw==" "sha1-2jmj7l5rSw0yVb/vlWAYkK/YBwk=" "sha1-zVToVowbN88eW62wd5vL84IhIYk=" "sha1-bRLhCx0zHa0hDkf9JdTyYIArfnc=" "sha256-47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU=" "sha256-kApEad8AzL/QwUXG0eS3lT3Qr6+t11NOOkAZ6NOPxmM=" "sha256-rQOHs72GUvcwykbSX5wXCvD9WJ9C5/I/Wp5kEtl9flY=" "sha512-z4PhNX7vuL3xVChQ1m2AB9Yg5AULVxXcg/SpIdNs6c5H0NE8XYXysP+DGNKHfuwvY7kxvUdBeoGlODJ6+SfaPg==" "sha512-nQiG+MaziTmKFiV7x5eA+rmDHH/BHIqwf6cyy3s0j+reOC+SYXycUwX++6CvAqtf05pYfTMJl/9b0NsZ92ZmUw==" "sha512-IWRLcqolnlpYjNOvuvsdQxD0iJaA9sg7nVMVlqWihPNNvr/0CdI7zIau5rrRDIkWBvB1xvR1XLU22ifbVpPzpw==" ]; } | |||
diff --git a/test/testdata/eval-okay-convertHash.nix b/test/testdata/eval-okay-convertHash.nix new file mode 100644 index 0000000..a0191ee --- /dev/null +++ b/test/testdata/eval-okay-convertHash.nix | |||
@@ -0,0 +1,33 @@ | |||
1 | let | ||
2 | hashAlgos = [ "md5" "md5" "md5" "sha1" "sha1" "sha1" "sha256" "sha256" "sha256" "sha512" "sha512" "sha512" ]; | ||
3 | hashesBase16 = import ./eval-okay-hashstring.exp; | ||
4 | map2 = f: { fsts, snds }: if fsts == [ ] then [ ] else [ (f (builtins.head fsts) (builtins.head snds)) ] ++ map2 f { fsts = builtins.tail fsts; snds = builtins.tail snds; }; | ||
5 | map2' = f: fsts: snds: map2 f { inherit fsts snds; }; | ||
6 | getOutputHashes = hashes: { | ||
7 | hashesBase16 = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "base16";}) hashAlgos hashes; | ||
8 | hashesNix32 = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "nix32";}) hashAlgos hashes; | ||
9 | hashesBase32 = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "base32";}) hashAlgos hashes; | ||
10 | hashesBase64 = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "base64";}) hashAlgos hashes; | ||
11 | hashesSRI = map2' (hashAlgo: hash: builtins.convertHash { inherit hash hashAlgo; toHashFormat = "sri" ;}) hashAlgos hashes; | ||
12 | }; | ||
13 | getOutputHashesColon = hashes: { | ||
14 | hashesBase16 = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "base16";}) hashAlgos hashes; | ||
15 | hashesNix32 = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "nix32";}) hashAlgos hashes; | ||
16 | hashesBase32 = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "base32";}) hashAlgos hashes; | ||
17 | hashesBase64 = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "base64";}) hashAlgos hashes; | ||
18 | hashesSRI = map2' (hashAlgo: hashBody: builtins.convertHash { hash = hashAlgo + ":" + hashBody; toHashFormat = "sri" ;}) hashAlgos hashes; | ||
19 | }; | ||
20 | outputHashes = getOutputHashes hashesBase16; | ||
21 | in | ||
22 | # map2'` | ||
23 | assert map2' (s1: s2: s1 + s2) [ "a" "b" ] [ "c" "d" ] == [ "ac" "bd" ]; | ||
24 | # hashesBase16 | ||
25 | assert outputHashes.hashesBase16 == hashesBase16; | ||
26 | # standard SRI hashes | ||
27 | assert outputHashes.hashesSRI == (map2' (hashAlgo: hashBody: hashAlgo + "-" + hashBody) hashAlgos outputHashes.hashesBase64); | ||
28 | # without prefix | ||
29 | assert builtins.all (x: getOutputHashes x == outputHashes) (builtins.attrValues outputHashes); | ||
30 | # colon-separated. | ||
31 | # Note that colon prefix must not be applied to the standard SRI. e.g. "sha256:sha256-..." is illegal. | ||
32 | assert builtins.all (x: getOutputHashesColon x == outputHashes) (with outputHashes; [ hashesBase16 hashesBase32 hashesBase64 ]); | ||
33 | outputHashes | ||
diff --git a/test/testdata/eval-okay-curpos.exp b/test/testdata/eval-okay-curpos.exp new file mode 100644 index 0000000..65fd65b --- /dev/null +++ b/test/testdata/eval-okay-curpos.exp | |||
@@ -0,0 +1 @@ | |||
[ 3 7 4 9 ] | |||
diff --git a/test/testdata/eval-okay-curpos.nix b/test/testdata/eval-okay-curpos.nix new file mode 100644 index 0000000..b79553d --- /dev/null +++ b/test/testdata/eval-okay-curpos.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | # Bla | ||
2 | let | ||
3 | x = __curPos; | ||
4 | y = __curPos; | ||
5 | in [ x.line x.column y.line y.column ] | ||
diff --git a/test/testdata/eval-okay-deepseq.exp b/test/testdata/eval-okay-deepseq.exp new file mode 100644 index 0000000..8d38505 --- /dev/null +++ b/test/testdata/eval-okay-deepseq.exp | |||
@@ -0,0 +1 @@ | |||
456 | |||
diff --git a/test/testdata/eval-okay-deepseq.nix b/test/testdata/eval-okay-deepseq.nix new file mode 100644 index 0000000..53aa4b1 --- /dev/null +++ b/test/testdata/eval-okay-deepseq.nix | |||
@@ -0,0 +1 @@ | |||
builtins.deepSeq (let as = { x = 123; y = as; }; in as) 456 | |||
diff --git a/test/testdata/eval-okay-delayed-with-inherit.exp b/test/testdata/eval-okay-delayed-with-inherit.exp new file mode 100644 index 0000000..eaacb55 --- /dev/null +++ b/test/testdata/eval-okay-delayed-with-inherit.exp | |||
@@ -0,0 +1 @@ | |||
"b-overridden" | |||
diff --git a/test/testdata/eval-okay-delayed-with-inherit.nix b/test/testdata/eval-okay-delayed-with-inherit.nix new file mode 100644 index 0000000..84b388c --- /dev/null +++ b/test/testdata/eval-okay-delayed-with-inherit.nix | |||
@@ -0,0 +1,24 @@ | |||
1 | let | ||
2 | pkgs_ = with pkgs; { | ||
3 | a = derivation { | ||
4 | name = "a"; | ||
5 | system = builtins.currentSystem; | ||
6 | builder = "/bin/sh"; | ||
7 | args = [ "-c" "touch $out" ]; | ||
8 | inherit b; | ||
9 | }; | ||
10 | |||
11 | inherit b; | ||
12 | }; | ||
13 | |||
14 | packageOverrides = p: { | ||
15 | b = derivation { | ||
16 | name = "b-overridden"; | ||
17 | system = builtins.currentSystem; | ||
18 | builder = "/bin/sh"; | ||
19 | args = [ "-c" "touch $out" ]; | ||
20 | }; | ||
21 | }; | ||
22 | |||
23 | pkgs = pkgs_ // (packageOverrides pkgs_); | ||
24 | in pkgs.a.b.name | ||
diff --git a/test/testdata/eval-okay-delayed-with.exp b/test/testdata/eval-okay-delayed-with.exp new file mode 100644 index 0000000..8e7c61a --- /dev/null +++ b/test/testdata/eval-okay-delayed-with.exp | |||
@@ -0,0 +1 @@ | |||
"b-overridden b-overridden a" | |||
diff --git a/test/testdata/eval-okay-delayed-with.nix b/test/testdata/eval-okay-delayed-with.nix new file mode 100644 index 0000000..3fb023e --- /dev/null +++ b/test/testdata/eval-okay-delayed-with.nix | |||
@@ -0,0 +1,29 @@ | |||
1 | let | ||
2 | |||
3 | pkgs_ = with pkgs; { | ||
4 | a = derivation { | ||
5 | name = "a"; | ||
6 | system = builtins.currentSystem; | ||
7 | builder = "/bin/sh"; | ||
8 | args = [ "-c" "touch $out" ]; | ||
9 | inherit b; | ||
10 | }; | ||
11 | |||
12 | b = derivation { | ||
13 | name = "b"; | ||
14 | system = builtins.currentSystem; | ||
15 | builder = "/bin/sh"; | ||
16 | args = [ "-c" "touch $out" ]; | ||
17 | inherit a; | ||
18 | }; | ||
19 | |||
20 | c = b; | ||
21 | }; | ||
22 | |||
23 | packageOverrides = pkgs: with pkgs; { | ||
24 | b = derivation (b.drvAttrs // { name = "${b.name}-overridden"; }); | ||
25 | }; | ||
26 | |||
27 | pkgs = pkgs_ // (packageOverrides pkgs_); | ||
28 | |||
29 | in "${pkgs.a.b.name} ${pkgs.c.name} ${pkgs.b.a.name}" | ||
diff --git a/test/testdata/eval-okay-derivation-legacy.err.exp b/test/testdata/eval-okay-derivation-legacy.err.exp new file mode 100644 index 0000000..94f0854 --- /dev/null +++ b/test/testdata/eval-okay-derivation-legacy.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'allowedReferences'; use 'outputChecks.<output>.allowedReferences' instead | ||
2 | warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'allowedRequisites'; use 'outputChecks.<output>.allowedRequisites' instead | ||
3 | warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'disallowedReferences'; use 'outputChecks.<output>.disallowedReferences' instead | ||
4 | warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'disallowedRequisites'; use 'outputChecks.<output>.disallowedRequisites' instead | ||
5 | warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'maxClosureSize'; use 'outputChecks.<output>.maxClosureSize' instead | ||
6 | warning: In a derivation named 'eval-okay-derivation-legacy', 'structuredAttrs' disables the effect of the derivation attribute 'maxSize'; use 'outputChecks.<output>.maxSize' instead | ||
diff --git a/test/testdata/eval-okay-derivation-legacy.exp b/test/testdata/eval-okay-derivation-legacy.exp new file mode 100644 index 0000000..4f374a1 --- /dev/null +++ b/test/testdata/eval-okay-derivation-legacy.exp | |||
@@ -0,0 +1 @@ | |||
"/nix/store/mzgwvrjjir216ra58mwwizi8wj6y9ddr-eval-okay-derivation-legacy" | |||
diff --git a/test/testdata/eval-okay-derivation-legacy.nix b/test/testdata/eval-okay-derivation-legacy.nix new file mode 100644 index 0000000..b529cdf --- /dev/null +++ b/test/testdata/eval-okay-derivation-legacy.nix | |||
@@ -0,0 +1,12 @@ | |||
1 | (builtins.derivationStrict { | ||
2 | name = "eval-okay-derivation-legacy"; | ||
3 | system = "x86_64-linux"; | ||
4 | builder = "/dontcare"; | ||
5 | __structuredAttrs = true; | ||
6 | allowedReferences = [ ]; | ||
7 | disallowedReferences = [ ]; | ||
8 | allowedRequisites = [ ]; | ||
9 | disallowedRequisites = [ ]; | ||
10 | maxSize = 1234; | ||
11 | maxClosureSize = 12345; | ||
12 | }).out | ||
diff --git a/test/testdata/eval-okay-dynamic-attrs-2.exp b/test/testdata/eval-okay-dynamic-attrs-2.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-dynamic-attrs-2.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-dynamic-attrs-2.nix b/test/testdata/eval-okay-dynamic-attrs-2.nix new file mode 100644 index 0000000..6d57bf8 --- /dev/null +++ b/test/testdata/eval-okay-dynamic-attrs-2.nix | |||
@@ -0,0 +1 @@ | |||
{ a."${"b"}" = true; a."${"c"}" = false; }.a.b | |||
diff --git a/test/testdata/eval-okay-dynamic-attrs-bare.exp b/test/testdata/eval-okay-dynamic-attrs-bare.exp new file mode 100644 index 0000000..df8750a --- /dev/null +++ b/test/testdata/eval-okay-dynamic-attrs-bare.exp | |||
@@ -0,0 +1 @@ | |||
{ binds = true; hasAttrs = true; multiAttrs = true; recBinds = true; selectAttrs = true; selectOrAttrs = true; } | |||
diff --git a/test/testdata/eval-okay-dynamic-attrs-bare.nix b/test/testdata/eval-okay-dynamic-attrs-bare.nix new file mode 100644 index 0000000..0dbe15e --- /dev/null +++ b/test/testdata/eval-okay-dynamic-attrs-bare.nix | |||
@@ -0,0 +1,17 @@ | |||
1 | let | ||
2 | aString = "a"; | ||
3 | |||
4 | bString = "b"; | ||
5 | in { | ||
6 | hasAttrs = { a.b = null; } ? ${aString}.b; | ||
7 | |||
8 | selectAttrs = { a.b = true; }.a.${bString}; | ||
9 | |||
10 | selectOrAttrs = { }.${aString} or true; | ||
11 | |||
12 | binds = { ${aString}."${bString}c" = true; }.a.bc; | ||
13 | |||
14 | recBinds = rec { ${bString} = a; a = true; }.b; | ||
15 | |||
16 | multiAttrs = { ${aString} = true; ${bString} = false; }.a; | ||
17 | } | ||
diff --git a/test/testdata/eval-okay-dynamic-attrs.exp b/test/testdata/eval-okay-dynamic-attrs.exp new file mode 100644 index 0000000..df8750a --- /dev/null +++ b/test/testdata/eval-okay-dynamic-attrs.exp | |||
@@ -0,0 +1 @@ | |||
{ binds = true; hasAttrs = true; multiAttrs = true; recBinds = true; selectAttrs = true; selectOrAttrs = true; } | |||
diff --git a/test/testdata/eval-okay-dynamic-attrs.nix b/test/testdata/eval-okay-dynamic-attrs.nix new file mode 100644 index 0000000..ee02ac7 --- /dev/null +++ b/test/testdata/eval-okay-dynamic-attrs.nix | |||
@@ -0,0 +1,17 @@ | |||
1 | let | ||
2 | aString = "a"; | ||
3 | |||
4 | bString = "b"; | ||
5 | in { | ||
6 | hasAttrs = { a.b = null; } ? "${aString}".b; | ||
7 | |||
8 | selectAttrs = { a.b = true; }.a."${bString}"; | ||
9 | |||
10 | selectOrAttrs = { }."${aString}" or true; | ||
11 | |||
12 | binds = { "${aString}"."${bString}c" = true; }.a.bc; | ||
13 | |||
14 | recBinds = rec { "${bString}" = a; a = true; }.b; | ||
15 | |||
16 | multiAttrs = { "${aString}" = true; "${bString}" = false; }.a; | ||
17 | } | ||
diff --git a/test/testdata/eval-okay-elem.exp b/test/testdata/eval-okay-elem.exp new file mode 100644 index 0000000..3cf6c0e --- /dev/null +++ b/test/testdata/eval-okay-elem.exp | |||
@@ -0,0 +1 @@ | |||
[ true false 30 ] | |||
diff --git a/test/testdata/eval-okay-elem.nix b/test/testdata/eval-okay-elem.nix new file mode 100644 index 0000000..71ea7a4 --- /dev/null +++ b/test/testdata/eval-okay-elem.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | let xs = range 10 40; in | ||
4 | |||
5 | [ (builtins.elem 23 xs) (builtins.elem 42 xs) (builtins.elemAt xs 20) ] | ||
6 | |||
diff --git a/test/testdata/eval-okay-empty-args.exp b/test/testdata/eval-okay-empty-args.exp new file mode 100644 index 0000000..cb5537d --- /dev/null +++ b/test/testdata/eval-okay-empty-args.exp | |||
@@ -0,0 +1 @@ | |||
"ab" | |||
diff --git a/test/testdata/eval-okay-empty-args.nix b/test/testdata/eval-okay-empty-args.nix new file mode 100644 index 0000000..78c133a --- /dev/null +++ b/test/testdata/eval-okay-empty-args.nix | |||
@@ -0,0 +1 @@ | |||
({}: {x,y,}: "${x}${y}") {} {x = "a"; y = "b";} | |||
diff --git a/test/testdata/eval-okay-eq-derivations.exp b/test/testdata/eval-okay-eq-derivations.exp new file mode 100644 index 0000000..ec04aab --- /dev/null +++ b/test/testdata/eval-okay-eq-derivations.exp | |||
@@ -0,0 +1 @@ | |||
[ true true true false ] | |||
diff --git a/test/testdata/eval-okay-eq-derivations.nix b/test/testdata/eval-okay-eq-derivations.nix new file mode 100644 index 0000000..d526cb4 --- /dev/null +++ b/test/testdata/eval-okay-eq-derivations.nix | |||
@@ -0,0 +1,10 @@ | |||
1 | let | ||
2 | |||
3 | drvA1 = derivation { name = "a"; builder = "/foo"; system = "i686-linux"; }; | ||
4 | drvA2 = derivation { name = "a"; builder = "/foo"; system = "i686-linux"; }; | ||
5 | drvA3 = derivation { name = "a"; builder = "/foo"; system = "i686-linux"; } // { dummy = 1; }; | ||
6 | |||
7 | drvC1 = derivation { name = "c"; builder = "/foo"; system = "i686-linux"; }; | ||
8 | drvC2 = derivation { name = "c"; builder = "/bar"; system = "i686-linux"; }; | ||
9 | |||
10 | in [ (drvA1 == drvA1) (drvA1 == drvA2) (drvA1 == drvA3) (drvC1 == drvC2) ] | ||
diff --git a/test/testdata/eval-okay-eq.exp b/test/testdata/eval-okay-eq.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-eq.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-eq.nix b/test/testdata/eval-okay-eq.nix new file mode 100644 index 0000000..73d200b --- /dev/null +++ b/test/testdata/eval-okay-eq.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | ["foobar" (rec {x = 1; y = x;})] | ||
2 | == | ||
3 | [("foo" + "bar") ({x = 1; y = 1;})] | ||
diff --git a/test/testdata/eval-okay-filter.exp b/test/testdata/eval-okay-filter.exp new file mode 100644 index 0000000..355d51c --- /dev/null +++ b/test/testdata/eval-okay-filter.exp | |||
@@ -0,0 +1 @@ | |||
[ 0 2 4 6 8 10 100 102 104 106 108 110 ] | |||
diff --git a/test/testdata/eval-okay-filter.nix b/test/testdata/eval-okay-filter.nix new file mode 100644 index 0000000..85109b0 --- /dev/null +++ b/test/testdata/eval-okay-filter.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | builtins.filter | ||
4 | (x: x / 2 * 2 == x) | ||
5 | (builtins.concatLists [ (range 0 10) (range 100 110) ]) | ||
diff --git a/test/testdata/eval-okay-flake-ref-to-string.exp b/test/testdata/eval-okay-flake-ref-to-string.exp new file mode 100644 index 0000000..110f844 --- /dev/null +++ b/test/testdata/eval-okay-flake-ref-to-string.exp | |||
@@ -0,0 +1 @@ | |||
"github:NixOS/nixpkgs/23.05?dir=lib" | |||
diff --git a/test/testdata/eval-okay-flake-ref-to-string.nix b/test/testdata/eval-okay-flake-ref-to-string.nix new file mode 100644 index 0000000..dbb4e5b --- /dev/null +++ b/test/testdata/eval-okay-flake-ref-to-string.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | builtins.flakeRefToString { | ||
2 | type = "github"; | ||
3 | owner = "NixOS"; | ||
4 | repo = "nixpkgs"; | ||
5 | ref = "23.05"; | ||
6 | dir = "lib"; | ||
7 | } | ||
diff --git a/test/testdata/eval-okay-flatten.exp b/test/testdata/eval-okay-flatten.exp new file mode 100644 index 0000000..b979b2b --- /dev/null +++ b/test/testdata/eval-okay-flatten.exp | |||
@@ -0,0 +1 @@ | |||
"1234567" | |||
diff --git a/test/testdata/eval-okay-flatten.nix b/test/testdata/eval-okay-flatten.nix new file mode 100644 index 0000000..fe911e9 --- /dev/null +++ b/test/testdata/eval-okay-flatten.nix | |||
@@ -0,0 +1,8 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | let { | ||
4 | |||
5 | l = ["1" "2" ["3" ["4"] ["5" "6"]] "7"]; | ||
6 | |||
7 | body = concat (flatten l); | ||
8 | } | ||
diff --git a/test/testdata/eval-okay-float.exp b/test/testdata/eval-okay-float.exp new file mode 100644 index 0000000..3c50a8a --- /dev/null +++ b/test/testdata/eval-okay-float.exp | |||
@@ -0,0 +1 @@ | |||
[ 3.4 3.5 2.5 1.5 ] | |||
diff --git a/test/testdata/eval-okay-float.nix b/test/testdata/eval-okay-float.nix new file mode 100644 index 0000000..b2702c7 --- /dev/null +++ b/test/testdata/eval-okay-float.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | [ | ||
2 | (1.1 + 2.3) | ||
3 | (builtins.add (0.5 + 0.5) (2.0 + 0.5)) | ||
4 | ((0.5 + 0.5) * (2.0 + 0.5)) | ||
5 | ((1.5 + 1.5) / (0.5 * 4.0)) | ||
6 | ] | ||
diff --git a/test/testdata/eval-okay-floor-ceil.exp b/test/testdata/eval-okay-floor-ceil.exp new file mode 100644 index 0000000..81f8042 --- /dev/null +++ b/test/testdata/eval-okay-floor-ceil.exp | |||
@@ -0,0 +1 @@ | |||
"23;24;23;23" | |||
diff --git a/test/testdata/eval-okay-floor-ceil.nix b/test/testdata/eval-okay-floor-ceil.nix new file mode 100644 index 0000000..d76a0d8 --- /dev/null +++ b/test/testdata/eval-okay-floor-ceil.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | let | ||
4 | n1 = builtins.floor 23.5; | ||
5 | n2 = builtins.ceil 23.5; | ||
6 | n3 = builtins.floor 23; | ||
7 | n4 = builtins.ceil 23; | ||
8 | in | ||
9 | builtins.concatStringsSep ";" (map toString [ n1 n2 n3 n4 ]) | ||
diff --git a/test/testdata/eval-okay-foldlStrict-lazy-elements.exp b/test/testdata/eval-okay-foldlStrict-lazy-elements.exp new file mode 100644 index 0000000..d81cc07 --- /dev/null +++ b/test/testdata/eval-okay-foldlStrict-lazy-elements.exp | |||
@@ -0,0 +1 @@ | |||
42 | |||
diff --git a/test/testdata/eval-okay-foldlStrict-lazy-elements.nix b/test/testdata/eval-okay-foldlStrict-lazy-elements.nix new file mode 100644 index 0000000..c666e07 --- /dev/null +++ b/test/testdata/eval-okay-foldlStrict-lazy-elements.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | # Tests that the rhs argument of op is not forced unconditionally | ||
2 | let | ||
3 | lst = builtins.foldl' | ||
4 | (acc: x: acc ++ [ x ]) | ||
5 | [ ] | ||
6 | [ 42 (throw "this shouldn't be evaluated") ]; | ||
7 | in | ||
8 | |||
9 | builtins.head lst | ||
diff --git a/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.exp b/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.exp new file mode 100644 index 0000000..d81cc07 --- /dev/null +++ b/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.exp | |||
@@ -0,0 +1 @@ | |||
42 | |||
diff --git a/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.nix b/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.nix new file mode 100644 index 0000000..abcd536 --- /dev/null +++ b/test/testdata/eval-okay-foldlStrict-lazy-initial-accumulator.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | # Checks that the nul value for the accumulator is not forced unconditionally. | ||
2 | # Some languages provide a foldl' that is strict in this argument, but Nix does not. | ||
3 | builtins.foldl' | ||
4 | (_: x: x) | ||
5 | (throw "This is never forced") | ||
6 | [ "but the results of applying op are" 42 ] | ||
diff --git a/test/testdata/eval-okay-foldlStrict.exp b/test/testdata/eval-okay-foldlStrict.exp new file mode 100644 index 0000000..837e12b --- /dev/null +++ b/test/testdata/eval-okay-foldlStrict.exp | |||
@@ -0,0 +1 @@ | |||
500500 | |||
diff --git a/test/testdata/eval-okay-foldlStrict.nix b/test/testdata/eval-okay-foldlStrict.nix new file mode 100644 index 0000000..3b87188 --- /dev/null +++ b/test/testdata/eval-okay-foldlStrict.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | builtins.foldl' (x: y: x + y) 0 (range 1 1000) | ||
diff --git a/test/testdata/eval-okay-fromTOML-timestamps.exp b/test/testdata/eval-okay-fromTOML-timestamps.exp new file mode 100644 index 0000000..08b3c69 --- /dev/null +++ b/test/testdata/eval-okay-fromTOML-timestamps.exp | |||
@@ -0,0 +1 @@ | |||
{ "1234" = "value"; "127.0.0.1" = "value"; a = { b = { c = { }; }; }; arr1 = [ 1 2 3 ]; arr2 = [ "red" "yellow" "green" ]; arr3 = [ [ 1 2 ] [ 3 4 5 ] ]; arr4 = [ "all" "strings" "are the same" "type" ]; arr5 = [ [ 1 2 ] [ "a" "b" "c" ] ]; arr7 = [ 1 2 3 ]; arr8 = [ 1 2 ]; bare-key = "value"; bare_key = "value"; bin1 = 214; bool1 = true; bool2 = false; "character encoding" = "value"; d = { e = { f = { }; }; }; dog = { "tater.man" = { type = { name = "pug"; }; }; }; flt1 = 1; flt2 = 3.1415; flt3 = -0.01; flt4 = 5e+22; flt5 = 1e+06; flt6 = -0.02; flt7 = 6.626e-34; flt8 = 9.22462e+06; fruit = [ { name = "apple"; physical = { color = "red"; shape = "round"; }; variety = [ { name = "red delicious"; } { name = "granny smith"; } ]; } { name = "banana"; variety = [ { name = "plantain"; } ]; } ]; g = { h = { i = { }; }; }; hex1 = 3735928559; hex2 = 3735928559; hex3 = 3735928559; int1 = 99; int2 = 42; int3 = 0; int4 = -17; int5 = 1000; int6 = 5349221; int7 = 12345; j = { "ʞ" = { l = { }; }; }; key = "value"; key2 = "value"; ld1 = { _type = "timestamp"; value = "1979-05-27"; }; ldt1 = { _type = "timestamp"; value = "1979-05-27T07:32:00"; }; ldt2 = { _type = "timestamp"; value = "1979-05-27T00:32:00.999999"; }; lt1 = { _type = "timestamp"; value = "07:32:00"; }; lt2 = { _type = "timestamp"; value = "00:32:00.999999"; }; name = "Orange"; oct1 = 342391; oct2 = 493; odt1 = { _type = "timestamp"; value = "1979-05-27T07:32:00Z"; }; odt2 = { _type = "timestamp"; value = "1979-05-27T00:32:00-07:00"; }; odt3 = { _type = "timestamp"; value = "1979-05-27T00:32:00.999999-07:00"; }; odt4 = { _type = "timestamp"; value = "1979-05-27T07:32:00Z"; }; physical = { color = "orange"; shape = "round"; }; products = [ { name = "Hammer"; sku = 738594937; } { } { color = "gray"; name = "Nail"; sku = 284758393; } ]; "quoted \"value\"" = "value"; site = { "google.com" = true; }; str = "I'm a string. \"You can quote me\". Name\tJosé\nLocation\tSF."; table-1 = { key1 = "some string"; key2 = 123; }; table-2 = { key1 = "another string"; key2 = 456; }; x = { y = { z = { w = { animal = { type = { name = "pug"; }; }; name = { first = "Tom"; last = "Preston-Werner"; }; point = { x = 1; y = 2; }; }; }; }; }; "ʎǝʞ" = "value"; } | |||
diff --git a/test/testdata/eval-okay-fromTOML-timestamps.flags b/test/testdata/eval-okay-fromTOML-timestamps.flags new file mode 100644 index 0000000..9ed39dc --- /dev/null +++ b/test/testdata/eval-okay-fromTOML-timestamps.flags | |||
@@ -0,0 +1 @@ | |||
--extra-experimental-features parse-toml-timestamps | |||
diff --git a/test/testdata/eval-okay-fromTOML-timestamps.nix b/test/testdata/eval-okay-fromTOML-timestamps.nix new file mode 100644 index 0000000..74cff94 --- /dev/null +++ b/test/testdata/eval-okay-fromTOML-timestamps.nix | |||
@@ -0,0 +1,130 @@ | |||
1 | builtins.fromTOML '' | ||
2 | key = "value" | ||
3 | bare_key = "value" | ||
4 | bare-key = "value" | ||
5 | 1234 = "value" | ||
6 | |||
7 | "127.0.0.1" = "value" | ||
8 | "character encoding" = "value" | ||
9 | "ʎǝʞ" = "value" | ||
10 | 'key2' = "value" | ||
11 | 'quoted "value"' = "value" | ||
12 | |||
13 | name = "Orange" | ||
14 | |||
15 | physical.color = "orange" | ||
16 | physical.shape = "round" | ||
17 | site."google.com" = true | ||
18 | |||
19 | # This is legal according to the spec, but cpptoml doesn't handle it. | ||
20 | #a.b.c = 1 | ||
21 | #a.d = 2 | ||
22 | |||
23 | str = "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF." | ||
24 | |||
25 | int1 = +99 | ||
26 | int2 = 42 | ||
27 | int3 = 0 | ||
28 | int4 = -17 | ||
29 | int5 = 1_000 | ||
30 | int6 = 5_349_221 | ||
31 | int7 = 1_2_3_4_5 | ||
32 | |||
33 | hex1 = 0xDEADBEEF | ||
34 | hex2 = 0xdeadbeef | ||
35 | hex3 = 0xdead_beef | ||
36 | |||
37 | oct1 = 0o01234567 | ||
38 | oct2 = 0o755 | ||
39 | |||
40 | bin1 = 0b11010110 | ||
41 | |||
42 | flt1 = +1.0 | ||
43 | flt2 = 3.1415 | ||
44 | flt3 = -0.01 | ||
45 | flt4 = 5e+22 | ||
46 | flt5 = 1e6 | ||
47 | flt6 = -2E-2 | ||
48 | flt7 = 6.626e-34 | ||
49 | flt8 = 9_224_617.445_991_228_313 | ||
50 | |||
51 | bool1 = true | ||
52 | bool2 = false | ||
53 | |||
54 | odt1 = 1979-05-27T07:32:00Z | ||
55 | odt2 = 1979-05-27T00:32:00-07:00 | ||
56 | odt3 = 1979-05-27T00:32:00.999999-07:00 | ||
57 | odt4 = 1979-05-27 07:32:00Z | ||
58 | ldt1 = 1979-05-27T07:32:00 | ||
59 | ldt2 = 1979-05-27T00:32:00.999999 | ||
60 | ld1 = 1979-05-27 | ||
61 | lt1 = 07:32:00 | ||
62 | lt2 = 00:32:00.999999 | ||
63 | |||
64 | arr1 = [ 1, 2, 3 ] | ||
65 | arr2 = [ "red", "yellow", "green" ] | ||
66 | arr3 = [ [ 1, 2 ], [3, 4, 5] ] | ||
67 | arr4 = [ "all", 'strings', """are the same""", ''''type''''] | ||
68 | arr5 = [ [ 1, 2 ], ["a", "b", "c"] ] | ||
69 | |||
70 | arr7 = [ | ||
71 | 1, 2, 3 | ||
72 | ] | ||
73 | |||
74 | arr8 = [ | ||
75 | 1, | ||
76 | 2, # this is ok | ||
77 | ] | ||
78 | |||
79 | [table-1] | ||
80 | key1 = "some string" | ||
81 | key2 = 123 | ||
82 | |||
83 | |||
84 | [table-2] | ||
85 | key1 = "another string" | ||
86 | key2 = 456 | ||
87 | |||
88 | [dog."tater.man"] | ||
89 | type.name = "pug" | ||
90 | |||
91 | [a.b.c] | ||
92 | [ d.e.f ] | ||
93 | [ g . h . i ] | ||
94 | [ j . "ʞ" . 'l' ] | ||
95 | [x.y.z.w] | ||
96 | |||
97 | name = { first = "Tom", last = "Preston-Werner" } | ||
98 | point = { x = 1, y = 2 } | ||
99 | animal = { type.name = "pug" } | ||
100 | |||
101 | [[products]] | ||
102 | name = "Hammer" | ||
103 | sku = 738594937 | ||
104 | |||
105 | [[products]] | ||
106 | |||
107 | [[products]] | ||
108 | name = "Nail" | ||
109 | sku = 284758393 | ||
110 | color = "gray" | ||
111 | |||
112 | [[fruit]] | ||
113 | name = "apple" | ||
114 | |||
115 | [fruit.physical] | ||
116 | color = "red" | ||
117 | shape = "round" | ||
118 | |||
119 | [[fruit.variety]] | ||
120 | name = "red delicious" | ||
121 | |||
122 | [[fruit.variety]] | ||
123 | name = "granny smith" | ||
124 | |||
125 | [[fruit]] | ||
126 | name = "banana" | ||
127 | |||
128 | [[fruit.variety]] | ||
129 | name = "plantain" | ||
130 | '' | ||
diff --git a/test/testdata/eval-okay-fromTOML.exp b/test/testdata/eval-okay-fromTOML.exp new file mode 100644 index 0000000..d0dd3af --- /dev/null +++ b/test/testdata/eval-okay-fromTOML.exp | |||
@@ -0,0 +1 @@ | |||
[ { clients = { data = [ [ "gamma" "delta" ] [ 1 2 ] ]; hosts = [ "alpha" "omega" ]; }; database = { connection_max = 5000; enabled = true; ports = [ 8001 8001 8002 ]; server = "192.168.1.1"; }; owner = { name = "Tom Preston-Werner"; }; servers = { alpha = { dc = "eqdc10"; ip = "10.0.0.1"; }; beta = { dc = "eqdc10"; ip = "10.0.0.2"; }; }; title = "TOML Example"; } { "1234" = "value"; "127.0.0.1" = "value"; a = { b = { c = { }; }; }; arr1 = [ 1 2 3 ]; arr2 = [ "red" "yellow" "green" ]; arr3 = [ [ 1 2 ] [ 3 4 5 ] ]; arr4 = [ "all" "strings" "are the same" "type" ]; arr5 = [ [ 1 2 ] [ "a" "b" "c" ] ]; arr7 = [ 1 2 3 ]; arr8 = [ 1 2 ]; bare-key = "value"; bare_key = "value"; bin1 = 214; bool1 = true; bool2 = false; "character encoding" = "value"; d = { e = { f = { }; }; }; dog = { "tater.man" = { type = { name = "pug"; }; }; }; flt1 = 1; flt2 = 3.1415; flt3 = -0.01; flt4 = 5e+22; flt5 = 1e+06; flt6 = -0.02; flt7 = 6.626e-34; flt8 = 9.22462e+06; fruit = [ { name = "apple"; physical = { color = "red"; shape = "round"; }; variety = [ { name = "red delicious"; } { name = "granny smith"; } ]; } { name = "banana"; variety = [ { name = "plantain"; } ]; } ]; g = { h = { i = { }; }; }; hex1 = 3735928559; hex2 = 3735928559; hex3 = 3735928559; int1 = 99; int2 = 42; int3 = 0; int4 = -17; int5 = 1000; int6 = 5349221; int7 = 12345; j = { "ʞ" = { l = { }; }; }; key = "value"; key2 = "value"; name = "Orange"; oct1 = 342391; oct2 = 493; physical = { color = "orange"; shape = "round"; }; products = [ { name = "Hammer"; sku = 738594937; } { } { color = "gray"; name = "Nail"; sku = 284758393; } ]; "quoted \"value\"" = "value"; site = { "google.com" = true; }; str = "I'm a string. \"You can quote me\". Name\tJosé\nLocation\tSF."; table-1 = { key1 = "some string"; key2 = 123; }; table-2 = { key1 = "another string"; key2 = 456; }; x = { y = { z = { w = { animal = { type = { name = "pug"; }; }; name = { first = "Tom"; last = "Preston-Werner"; }; point = { x = 1; y = 2; }; }; }; }; }; "ʎǝʞ" = "value"; } { metadata = { "checksum aho-corasick 0.6.4 (registry+https://github.com/rust-lang/crates.io-index)" = "d6531d44de723825aa81398a6415283229725a00fa30713812ab9323faa82fc4"; "checksum ansi_term 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ee49baf6cb617b853aa8d93bf420db2383fab46d314482ca2803b40d5fde979b"; "checksum ansi_term 0.9.0 (registry+https://github.com/rust-lang/crates.io-index)" = "23ac7c30002a5accbf7e8987d0632fa6de155b7c3d39d0067317a391e00a2ef6"; "checksum arrayvec 0.4.7 (registry+https://github.com/rust-lang/crates.io-index)" = "a1e964f9e24d588183fcb43503abda40d288c8657dfc27311516ce2f05675aef"; }; package = [ { dependencies = [ "memchr 2.0.1 (registry+https://github.com/rust-lang/crates.io-index)" ]; name = "aho-corasick"; source = "registry+https://github.com/rust-lang/crates.io-index"; version = "0.6.4"; } { name = "ansi_term"; source = "registry+https://github.com/rust-lang/crates.io-index"; version = "0.9.0"; } { dependencies = [ "libc 0.2.42 (registry+https://github.com/rust-lang/crates.io-index)" "termion 1.5.1 (registry+https://github.com/rust-lang/crates.io-index)" "winapi 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)" ]; name = "atty"; source = "registry+https://github.com/rust-lang/crates.io-index"; version = "0.2.10"; } ]; } { a = [ [ { b = true; } ] ]; c = [ [ { d = true; } ] ]; e = [ [ 123 ] ]; } ] | |||
diff --git a/test/testdata/eval-okay-fromTOML.nix b/test/testdata/eval-okay-fromTOML.nix new file mode 100644 index 0000000..9639326 --- /dev/null +++ b/test/testdata/eval-okay-fromTOML.nix | |||
@@ -0,0 +1,208 @@ | |||
1 | [ | ||
2 | |||
3 | (builtins.fromTOML '' | ||
4 | # This is a TOML document. | ||
5 | |||
6 | title = "TOML Example" | ||
7 | |||
8 | [owner] | ||
9 | name = "Tom Preston-Werner" | ||
10 | #dob = 1979-05-27T07:32:00-08:00 # First class dates | ||
11 | |||
12 | [database] | ||
13 | server = "192.168.1.1" | ||
14 | ports = [ 8001, 8001, 8002 ] | ||
15 | connection_max = 5000 | ||
16 | enabled = true | ||
17 | |||
18 | [servers] | ||
19 | |||
20 | # Indentation (tabs and/or spaces) is allowed but not required | ||
21 | [servers.alpha] | ||
22 | ip = "10.0.0.1" | ||
23 | dc = "eqdc10" | ||
24 | |||
25 | [servers.beta] | ||
26 | ip = "10.0.0.2" | ||
27 | dc = "eqdc10" | ||
28 | |||
29 | [clients] | ||
30 | data = [ ["gamma", "delta"], [1, 2] ] | ||
31 | |||
32 | # Line breaks are OK when inside arrays | ||
33 | hosts = [ | ||
34 | "alpha", | ||
35 | "omega" | ||
36 | ] | ||
37 | '') | ||
38 | |||
39 | (builtins.fromTOML '' | ||
40 | key = "value" | ||
41 | bare_key = "value" | ||
42 | bare-key = "value" | ||
43 | 1234 = "value" | ||
44 | |||
45 | "127.0.0.1" = "value" | ||
46 | "character encoding" = "value" | ||
47 | "ʎǝʞ" = "value" | ||
48 | 'key2' = "value" | ||
49 | 'quoted "value"' = "value" | ||
50 | |||
51 | name = "Orange" | ||
52 | |||
53 | physical.color = "orange" | ||
54 | physical.shape = "round" | ||
55 | site."google.com" = true | ||
56 | |||
57 | # This is legal according to the spec, but cpptoml doesn't handle it. | ||
58 | #a.b.c = 1 | ||
59 | #a.d = 2 | ||
60 | |||
61 | str = "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF." | ||
62 | |||
63 | int1 = +99 | ||
64 | int2 = 42 | ||
65 | int3 = 0 | ||
66 | int4 = -17 | ||
67 | int5 = 1_000 | ||
68 | int6 = 5_349_221 | ||
69 | int7 = 1_2_3_4_5 | ||
70 | |||
71 | hex1 = 0xDEADBEEF | ||
72 | hex2 = 0xdeadbeef | ||
73 | hex3 = 0xdead_beef | ||
74 | |||
75 | oct1 = 0o01234567 | ||
76 | oct2 = 0o755 | ||
77 | |||
78 | bin1 = 0b11010110 | ||
79 | |||
80 | flt1 = +1.0 | ||
81 | flt2 = 3.1415 | ||
82 | flt3 = -0.01 | ||
83 | flt4 = 5e+22 | ||
84 | flt5 = 1e6 | ||
85 | flt6 = -2E-2 | ||
86 | flt7 = 6.626e-34 | ||
87 | flt8 = 9_224_617.445_991_228_313 | ||
88 | |||
89 | bool1 = true | ||
90 | bool2 = false | ||
91 | |||
92 | # FIXME: not supported because Nix doesn't have a date/time type. | ||
93 | #odt1 = 1979-05-27T07:32:00Z | ||
94 | #odt2 = 1979-05-27T00:32:00-07:00 | ||
95 | #odt3 = 1979-05-27T00:32:00.999999-07:00 | ||
96 | #odt4 = 1979-05-27 07:32:00Z | ||
97 | #ldt1 = 1979-05-27T07:32:00 | ||
98 | #ldt2 = 1979-05-27T00:32:00.999999 | ||
99 | #ld1 = 1979-05-27 | ||
100 | #lt1 = 07:32:00 | ||
101 | #lt2 = 00:32:00.999999 | ||
102 | |||
103 | arr1 = [ 1, 2, 3 ] | ||
104 | arr2 = [ "red", "yellow", "green" ] | ||
105 | arr3 = [ [ 1, 2 ], [3, 4, 5] ] | ||
106 | arr4 = [ "all", 'strings', """are the same""", ''''type''''] | ||
107 | arr5 = [ [ 1, 2 ], ["a", "b", "c"] ] | ||
108 | |||
109 | arr7 = [ | ||
110 | 1, 2, 3 | ||
111 | ] | ||
112 | |||
113 | arr8 = [ | ||
114 | 1, | ||
115 | 2, # this is ok | ||
116 | ] | ||
117 | |||
118 | [table-1] | ||
119 | key1 = "some string" | ||
120 | key2 = 123 | ||
121 | |||
122 | |||
123 | [table-2] | ||
124 | key1 = "another string" | ||
125 | key2 = 456 | ||
126 | |||
127 | [dog."tater.man"] | ||
128 | type.name = "pug" | ||
129 | |||
130 | [a.b.c] | ||
131 | [ d.e.f ] | ||
132 | [ g . h . i ] | ||
133 | [ j . "ʞ" . 'l' ] | ||
134 | [x.y.z.w] | ||
135 | |||
136 | name = { first = "Tom", last = "Preston-Werner" } | ||
137 | point = { x = 1, y = 2 } | ||
138 | animal = { type.name = "pug" } | ||
139 | |||
140 | [[products]] | ||
141 | name = "Hammer" | ||
142 | sku = 738594937 | ||
143 | |||
144 | [[products]] | ||
145 | |||
146 | [[products]] | ||
147 | name = "Nail" | ||
148 | sku = 284758393 | ||
149 | color = "gray" | ||
150 | |||
151 | [[fruit]] | ||
152 | name = "apple" | ||
153 | |||
154 | [fruit.physical] | ||
155 | color = "red" | ||
156 | shape = "round" | ||
157 | |||
158 | [[fruit.variety]] | ||
159 | name = "red delicious" | ||
160 | |||
161 | [[fruit.variety]] | ||
162 | name = "granny smith" | ||
163 | |||
164 | [[fruit]] | ||
165 | name = "banana" | ||
166 | |||
167 | [[fruit.variety]] | ||
168 | name = "plantain" | ||
169 | '') | ||
170 | |||
171 | (builtins.fromTOML '' | ||
172 | [[package]] | ||
173 | name = "aho-corasick" | ||
174 | version = "0.6.4" | ||
175 | source = "registry+https://github.com/rust-lang/crates.io-index" | ||
176 | dependencies = [ | ||
177 | "memchr 2.0.1 (registry+https://github.com/rust-lang/crates.io-index)", | ||
178 | ] | ||
179 | |||
180 | [[package]] | ||
181 | name = "ansi_term" | ||
182 | version = "0.9.0" | ||
183 | source = "registry+https://github.com/rust-lang/crates.io-index" | ||
184 | |||
185 | [[package]] | ||
186 | name = "atty" | ||
187 | version = "0.2.10" | ||
188 | source = "registry+https://github.com/rust-lang/crates.io-index" | ||
189 | dependencies = [ | ||
190 | "libc 0.2.42 (registry+https://github.com/rust-lang/crates.io-index)", | ||
191 | "termion 1.5.1 (registry+https://github.com/rust-lang/crates.io-index)", | ||
192 | "winapi 0.3.5 (registry+https://github.com/rust-lang/crates.io-index)", | ||
193 | ] | ||
194 | |||
195 | [metadata] | ||
196 | "checksum aho-corasick 0.6.4 (registry+https://github.com/rust-lang/crates.io-index)" = "d6531d44de723825aa81398a6415283229725a00fa30713812ab9323faa82fc4" | ||
197 | "checksum ansi_term 0.11.0 (registry+https://github.com/rust-lang/crates.io-index)" = "ee49baf6cb617b853aa8d93bf420db2383fab46d314482ca2803b40d5fde979b" | ||
198 | "checksum ansi_term 0.9.0 (registry+https://github.com/rust-lang/crates.io-index)" = "23ac7c30002a5accbf7e8987d0632fa6de155b7c3d39d0067317a391e00a2ef6" | ||
199 | "checksum arrayvec 0.4.7 (registry+https://github.com/rust-lang/crates.io-index)" = "a1e964f9e24d588183fcb43503abda40d288c8657dfc27311516ce2f05675aef" | ||
200 | '') | ||
201 | |||
202 | (builtins.fromTOML '' | ||
203 | a = [[{ b = true }]] | ||
204 | c = [ [ { d = true } ] ] | ||
205 | e = [[123]] | ||
206 | '') | ||
207 | |||
208 | ] | ||
diff --git a/test/testdata/eval-okay-fromjson-escapes.exp b/test/testdata/eval-okay-fromjson-escapes.exp new file mode 100644 index 0000000..add5505 --- /dev/null +++ b/test/testdata/eval-okay-fromjson-escapes.exp | |||
@@ -0,0 +1 @@ | |||
"quote \" reverse solidus \\ solidus / backspace formfeed newline \n carriage return \r horizontal tab \t 1 char unicode encoded backspace 1 char unicode encoded e with accent é 2 char unicode encoded s with caron š 3 char unicode encoded rightwards arrow →" | |||
diff --git a/test/testdata/eval-okay-fromjson-escapes.nix b/test/testdata/eval-okay-fromjson-escapes.nix new file mode 100644 index 0000000..f007135 --- /dev/null +++ b/test/testdata/eval-okay-fromjson-escapes.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | # This string contains all supported escapes in a JSON string, per json.org | ||
2 | # \b and \f are not supported by Nix | ||
3 | builtins.fromJSON ''"quote \" reverse solidus \\ solidus \/ backspace \b formfeed \f newline \n carriage return \r horizontal tab \t 1 char unicode encoded backspace \u0008 1 char unicode encoded e with accent \u00e9 2 char unicode encoded s with caron \u0161 3 char unicode encoded rightwards arrow \u2192"'' | ||
diff --git a/test/testdata/eval-okay-fromjson.exp b/test/testdata/eval-okay-fromjson.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-fromjson.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-fromjson.nix b/test/testdata/eval-okay-fromjson.nix new file mode 100644 index 0000000..4c526b9 --- /dev/null +++ b/test/testdata/eval-okay-fromjson.nix | |||
@@ -0,0 +1,41 @@ | |||
1 | builtins.fromJSON | ||
2 | '' | ||
3 | { | ||
4 | "Video": { | ||
5 | "Title": "The Penguin Chronicles", | ||
6 | "Width": 1920, | ||
7 | "Height": 1080, | ||
8 | "EmbeddedData": [3.14159, 23493,null, true ,false, -10], | ||
9 | "Thumb": { | ||
10 | "Url": "http://www.example.com/video/5678931", | ||
11 | "Width": 200, | ||
12 | "Height": 250 | ||
13 | }, | ||
14 | "Animated" : false, | ||
15 | "IDs": [116, 943, 234, 38793, true ,false,null, -100], | ||
16 | "Escapes": "\"\\\/\t\n\r\t", | ||
17 | "Subtitle" : false, | ||
18 | "Latitude": 37.7668, | ||
19 | "Longitude": -122.3959 | ||
20 | } | ||
21 | } | ||
22 | '' | ||
23 | == | ||
24 | { Video = | ||
25 | { Title = "The Penguin Chronicles"; | ||
26 | Width = 1920; | ||
27 | Height = 1080; | ||
28 | EmbeddedData = [ 3.14159 23493 null true false (0-10) ]; | ||
29 | Thumb = | ||
30 | { Url = "http://www.example.com/video/5678931"; | ||
31 | Width = 200; | ||
32 | Height = 250; | ||
33 | }; | ||
34 | Animated = false; | ||
35 | IDs = [ 116 943 234 38793 true false null (0-100) ]; | ||
36 | Escapes = "\"\\\/\t\n\r\t"; # supported in JSON but not Nix: \b\f | ||
37 | Subtitle = false; | ||
38 | Latitude = 37.7668; | ||
39 | Longitude = -122.3959; | ||
40 | }; | ||
41 | } | ||
diff --git a/test/testdata/eval-okay-functionargs.exp b/test/testdata/eval-okay-functionargs.exp new file mode 100644 index 0000000..c1c9f8f --- /dev/null +++ b/test/testdata/eval-okay-functionargs.exp | |||
@@ -0,0 +1 @@ | |||
[ "stdenv" "fetchurl" "aterm-stdenv" "aterm-stdenv2" "libX11" "libXv" "mplayer-stdenv2.libXv-libX11" "mplayer-stdenv2.libXv-libX11_2" "nix-stdenv-aterm-stdenv" "nix-stdenv2-aterm2-stdenv2" ] | |||
diff --git a/test/testdata/eval-okay-functionargs.exp.xml b/test/testdata/eval-okay-functionargs.exp.xml new file mode 100644 index 0000000..651f54c --- /dev/null +++ b/test/testdata/eval-okay-functionargs.exp.xml | |||
@@ -0,0 +1,15 @@ | |||
1 | <?xml version='1.0' encoding='utf-8'?> | ||
2 | <expr> | ||
3 | <list> | ||
4 | <string value="stdenv" /> | ||
5 | <string value="fetchurl" /> | ||
6 | <string value="aterm-stdenv" /> | ||
7 | <string value="aterm-stdenv2" /> | ||
8 | <string value="libX11" /> | ||
9 | <string value="libXv" /> | ||
10 | <string value="mplayer-stdenv2.libXv-libX11" /> | ||
11 | <string value="mplayer-stdenv2.libXv-libX11_2" /> | ||
12 | <string value="nix-stdenv-aterm-stdenv" /> | ||
13 | <string value="nix-stdenv2-aterm2-stdenv2" /> | ||
14 | </list> | ||
15 | </expr> | ||
diff --git a/test/testdata/eval-okay-functionargs.nix b/test/testdata/eval-okay-functionargs.nix new file mode 100644 index 0000000..68dca62 --- /dev/null +++ b/test/testdata/eval-okay-functionargs.nix | |||
@@ -0,0 +1,80 @@ | |||
1 | let | ||
2 | |||
3 | stdenvFun = { }: { name = "stdenv"; }; | ||
4 | stdenv2Fun = { }: { name = "stdenv2"; }; | ||
5 | fetchurlFun = { stdenv }: assert stdenv.name == "stdenv"; { name = "fetchurl"; }; | ||
6 | atermFun = { stdenv, fetchurl }: { name = "aterm-${stdenv.name}"; }; | ||
7 | aterm2Fun = { stdenv, fetchurl }: { name = "aterm2-${stdenv.name}"; }; | ||
8 | nixFun = { stdenv, fetchurl, aterm }: { name = "nix-${stdenv.name}-${aterm.name}"; }; | ||
9 | |||
10 | mplayerFun = | ||
11 | { stdenv, fetchurl, enableX11 ? false, xorg ? null, enableFoo ? true, foo ? null }: | ||
12 | assert stdenv.name == "stdenv2"; | ||
13 | assert enableX11 -> xorg.libXv.name == "libXv"; | ||
14 | assert enableFoo -> foo != null; | ||
15 | { name = "mplayer-${stdenv.name}.${xorg.libXv.name}-${xorg.libX11.name}"; }; | ||
16 | |||
17 | makeOverridable = f: origArgs: f origArgs // | ||
18 | { override = newArgs: | ||
19 | makeOverridable f (origArgs // (if builtins.isFunction newArgs then newArgs origArgs else newArgs)); | ||
20 | }; | ||
21 | |||
22 | callPackage_ = pkgs: f: args: | ||
23 | makeOverridable f ((builtins.intersectAttrs (builtins.functionArgs f) pkgs) // args); | ||
24 | |||
25 | allPackages = | ||
26 | { overrides ? (pkgs: pkgsPrev: { }) }: | ||
27 | let | ||
28 | callPackage = callPackage_ pkgs; | ||
29 | pkgs = pkgsStd // (overrides pkgs pkgsStd); | ||
30 | pkgsStd = { | ||
31 | inherit pkgs; | ||
32 | stdenv = callPackage stdenvFun { }; | ||
33 | stdenv2 = callPackage stdenv2Fun { }; | ||
34 | fetchurl = callPackage fetchurlFun { }; | ||
35 | aterm = callPackage atermFun { }; | ||
36 | xorg = callPackage xorgFun { }; | ||
37 | mplayer = callPackage mplayerFun { stdenv = pkgs.stdenv2; enableFoo = false; }; | ||
38 | nix = callPackage nixFun { }; | ||
39 | }; | ||
40 | in pkgs; | ||
41 | |||
42 | libX11Fun = { stdenv, fetchurl }: { name = "libX11"; }; | ||
43 | libX11_2Fun = { stdenv, fetchurl }: { name = "libX11_2"; }; | ||
44 | libXvFun = { stdenv, fetchurl, libX11 }: { name = "libXv"; }; | ||
45 | |||
46 | xorgFun = | ||
47 | { pkgs }: | ||
48 | let callPackage = callPackage_ (pkgs // pkgs.xorg); in | ||
49 | { | ||
50 | libX11 = callPackage libX11Fun { }; | ||
51 | libXv = callPackage libXvFun { }; | ||
52 | }; | ||
53 | |||
54 | in | ||
55 | |||
56 | let | ||
57 | |||
58 | pkgs = allPackages { }; | ||
59 | |||
60 | pkgs2 = allPackages { | ||
61 | overrides = pkgs: pkgsPrev: { | ||
62 | stdenv = pkgs.stdenv2; | ||
63 | nix = pkgsPrev.nix.override { aterm = aterm2Fun { inherit (pkgs) stdenv fetchurl; }; }; | ||
64 | xorg = pkgsPrev.xorg // { libX11 = libX11_2Fun { inherit (pkgs) stdenv fetchurl; }; }; | ||
65 | }; | ||
66 | }; | ||
67 | |||
68 | in | ||
69 | |||
70 | [ pkgs.stdenv.name | ||
71 | pkgs.fetchurl.name | ||
72 | pkgs.aterm.name | ||
73 | pkgs2.aterm.name | ||
74 | pkgs.xorg.libX11.name | ||
75 | pkgs.xorg.libXv.name | ||
76 | pkgs.mplayer.name | ||
77 | pkgs2.mplayer.name | ||
78 | pkgs.nix.name | ||
79 | pkgs2.nix.name | ||
80 | ] | ||
diff --git a/test/testdata/eval-okay-getattrpos-functionargs.exp b/test/testdata/eval-okay-getattrpos-functionargs.exp new file mode 100644 index 0000000..7f9ac40 --- /dev/null +++ b/test/testdata/eval-okay-getattrpos-functionargs.exp | |||
@@ -0,0 +1 @@ | |||
{ column = 11; file = "eval-okay-getattrpos-functionargs.nix"; line = 2; } | |||
diff --git a/test/testdata/eval-okay-getattrpos-functionargs.nix b/test/testdata/eval-okay-getattrpos-functionargs.nix new file mode 100644 index 0000000..11d6bb0 --- /dev/null +++ b/test/testdata/eval-okay-getattrpos-functionargs.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | let | ||
2 | fun = { foo }: {}; | ||
3 | pos = builtins.unsafeGetAttrPos "foo" (builtins.functionArgs fun); | ||
4 | in { inherit (pos) column line; file = baseNameOf pos.file; } | ||
diff --git a/test/testdata/eval-okay-getattrpos-undefined.exp b/test/testdata/eval-okay-getattrpos-undefined.exp new file mode 100644 index 0000000..19765bd --- /dev/null +++ b/test/testdata/eval-okay-getattrpos-undefined.exp | |||
@@ -0,0 +1 @@ | |||
null | |||
diff --git a/test/testdata/eval-okay-getattrpos-undefined.nix b/test/testdata/eval-okay-getattrpos-undefined.nix new file mode 100644 index 0000000..14dd38f --- /dev/null +++ b/test/testdata/eval-okay-getattrpos-undefined.nix | |||
@@ -0,0 +1 @@ | |||
builtins.unsafeGetAttrPos "abort" builtins | |||
diff --git a/test/testdata/eval-okay-getattrpos.exp b/test/testdata/eval-okay-getattrpos.exp new file mode 100644 index 0000000..469249b --- /dev/null +++ b/test/testdata/eval-okay-getattrpos.exp | |||
@@ -0,0 +1 @@ | |||
{ column = 5; file = "eval-okay-getattrpos.nix"; line = 3; } | |||
diff --git a/test/testdata/eval-okay-getattrpos.nix b/test/testdata/eval-okay-getattrpos.nix new file mode 100644 index 0000000..ca6b079 --- /dev/null +++ b/test/testdata/eval-okay-getattrpos.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | let | ||
2 | as = { | ||
3 | foo = "bar"; | ||
4 | }; | ||
5 | pos = builtins.unsafeGetAttrPos "foo" as; | ||
6 | in { inherit (pos) column line; file = baseNameOf pos.file; } | ||
diff --git a/test/testdata/eval-okay-getenv.exp b/test/testdata/eval-okay-getenv.exp new file mode 100644 index 0000000..14e24d4 --- /dev/null +++ b/test/testdata/eval-okay-getenv.exp | |||
@@ -0,0 +1 @@ | |||
"foobar" | |||
diff --git a/test/testdata/eval-okay-getenv.nix b/test/testdata/eval-okay-getenv.nix new file mode 100644 index 0000000..4cfec5f --- /dev/null +++ b/test/testdata/eval-okay-getenv.nix | |||
@@ -0,0 +1 @@ | |||
builtins.getEnv "TEST_VAR" + (if builtins.getEnv "NO_SUCH_VAR" == "" then "bar" else "bla") | |||
diff --git a/test/testdata/eval-okay-groupBy.exp b/test/testdata/eval-okay-groupBy.exp new file mode 100644 index 0000000..bfca565 --- /dev/null +++ b/test/testdata/eval-okay-groupBy.exp | |||
@@ -0,0 +1 @@ | |||
{ "1" = [ 9 ]; "2" = [ 8 ]; "3" = [ 13 29 ]; "4" = [ 3 4 10 11 17 18 ]; "5" = [ 0 23 26 28 ]; "6" = [ 1 12 21 27 30 ]; "7" = [ 7 22 ]; "8" = [ 14 ]; "9" = [ 19 ]; b = [ 16 25 ]; c = [ 24 ]; d = [ 2 ]; e = [ 5 6 15 31 ]; f = [ 20 ]; } | |||
diff --git a/test/testdata/eval-okay-groupBy.nix b/test/testdata/eval-okay-groupBy.nix new file mode 100644 index 0000000..862d89d --- /dev/null +++ b/test/testdata/eval-okay-groupBy.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | builtins.groupBy (n: | ||
4 | builtins.substring 0 1 (builtins.hashString "sha256" (toString n)) | ||
5 | ) (range 0 31) | ||
diff --git a/test/testdata/eval-okay-hash.exp b/test/testdata/eval-okay-hash.exp new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/test/testdata/eval-okay-hash.exp | |||
diff --git a/test/testdata/eval-okay-hashfile.exp b/test/testdata/eval-okay-hashfile.exp new file mode 100644 index 0000000..ff1e829 --- /dev/null +++ b/test/testdata/eval-okay-hashfile.exp | |||
@@ -0,0 +1 @@ | |||
[ "d3b07384d113edec49eaa6238ad5ff00" "0f343b0931126a20f133d67c2b018a3b" "f1d2d2f924e986ac86fdf7b36c94bcdf32beec15" "60cacbf3d72e1e7834203da608037b1bf83b40e8" "b5bb9d8014a0f9b1d61e21e796d78dccdf1352f23cd32812f4850b878ae4944c" "5f70bf18a086007016e948b04aed3b82103a36bea41755b6cddfaf10ace3c6ef" "0cf9180a764aba863a67b6d72f0918bc131c6772642cb2dce5a34f0a702f9470ddc2bf125c12198b1995c233c34b4afd346c54a2334c350a948a51b6e8b4e6b6" "8efb4f73c5655351c444eb109230c556d39e2c7624e9c11abc9e3fb4b9b9254218cc5085b454a9698d085cfa92198491f07a723be4574adc70617b73eb0b6461" ] | |||
diff --git a/test/testdata/eval-okay-hashfile.nix b/test/testdata/eval-okay-hashfile.nix new file mode 100644 index 0000000..aff5a18 --- /dev/null +++ b/test/testdata/eval-okay-hashfile.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | let | ||
2 | paths = [ ./data ./binary-data ]; | ||
3 | in | ||
4 | builtins.concatLists (map (hash: map (builtins.hashFile hash) paths) ["md5" "sha1" "sha256" "sha512"]) | ||
diff --git a/test/testdata/eval-okay-hashstring.exp b/test/testdata/eval-okay-hashstring.exp new file mode 100644 index 0000000..d720a08 --- /dev/null +++ b/test/testdata/eval-okay-hashstring.exp | |||
@@ -0,0 +1 @@ | |||
[ "d41d8cd98f00b204e9800998ecf8427e" "6c69ee7f211c640419d5366cc076ae46" "bb3438fbabd460ea6dbd27d153e2233b" "da39a3ee5e6b4b0d3255bfef95601890afd80709" "cd54e8568c1b37cf1e5badb0779bcbf382212189" "6d12e10b1d331dad210e47fd25d4f260802b7e77" "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855" "900a4469df00ccbfd0c145c6d1e4b7953dd0afafadd7534e3a4019e8d38fc663" "ad0387b3bd8652f730ca46d25f9c170af0fd589f42e7f23f5a9e6412d97d7e56" "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e" "9d0886f8c6b389398a16257bc79780fab9831c7fc11c8ab07fa732cb7b348feade382f92617c9c5305fefba0af02ab5fd39a587d330997ff5bd0db19f7666653" "21644b72aa259e5a588cd3afbafb1d4310f4889680f6c83b9d531596a5a284f34dbebff409d23bcc86aee6bad10c891606f075c6f4755cb536da27db5693f3a7" ] | |||
diff --git a/test/testdata/eval-okay-hashstring.nix b/test/testdata/eval-okay-hashstring.nix new file mode 100644 index 0000000..b0f62b2 --- /dev/null +++ b/test/testdata/eval-okay-hashstring.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | let | ||
2 | strings = [ "" "text 1" "text 2" ]; | ||
3 | in | ||
4 | builtins.concatLists (map (hash: map (builtins.hashString hash) strings) ["md5" "sha1" "sha256" "sha512"]) | ||
diff --git a/test/testdata/eval-okay-if.exp b/test/testdata/eval-okay-if.exp new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/test/testdata/eval-okay-if.exp | |||
@@ -0,0 +1 @@ | |||
3 | |||
diff --git a/test/testdata/eval-okay-if.nix b/test/testdata/eval-okay-if.nix new file mode 100644 index 0000000..23e4c74 --- /dev/null +++ b/test/testdata/eval-okay-if.nix | |||
@@ -0,0 +1 @@ | |||
if "foo" != "f" + "oo" then 1 else if false then 2 else 3 | |||
diff --git a/test/testdata/eval-okay-import.exp b/test/testdata/eval-okay-import.exp new file mode 100644 index 0000000..c508125 --- /dev/null +++ b/test/testdata/eval-okay-import.exp | |||
@@ -0,0 +1 @@ | |||
[ 1 2 3 4 5 6 7 8 9 10 ] | |||
diff --git a/test/testdata/eval-okay-import.nix b/test/testdata/eval-okay-import.nix new file mode 100644 index 0000000..0b18d94 --- /dev/null +++ b/test/testdata/eval-okay-import.nix | |||
@@ -0,0 +1,11 @@ | |||
1 | let | ||
2 | |||
3 | overrides = { | ||
4 | import = fn: scopedImport overrides fn; | ||
5 | |||
6 | scopedImport = attrs: fn: scopedImport (overrides // attrs) fn; | ||
7 | |||
8 | builtins = builtins // overrides; | ||
9 | } // import ./lib.nix; | ||
10 | |||
11 | in scopedImport overrides ./imported.nix | ||
diff --git a/test/testdata/eval-okay-ind-string.exp b/test/testdata/eval-okay-ind-string.exp new file mode 100644 index 0000000..7862331 --- /dev/null +++ b/test/testdata/eval-okay-ind-string.exp | |||
@@ -0,0 +1 @@ | |||
"This is an indented multi-line string\nliteral. An amount of whitespace at\nthe start of each line matching the minimum\nindentation of all lines in the string\nliteral together will be removed. Thus,\nin this case four spaces will be\nstripped from each line, even though\n THIS LINE is indented six spaces.\n\nAlso, empty lines don't count in the\ndetermination of the indentation level (the\nprevious empty line has indentation 0, but\nit doesn't matter).\nIf the string starts with whitespace\n followed by a newline, it's stripped, but\n that's not the case here. Two spaces are\n stripped because of the \" \" at the start. \nThis line is indented\na bit further.\nAnti-quotations, like so, are\nalso allowed.\n The \\ is not special here.\n' can be followed by any character except another ', e.g. 'x'.\nLikewise for $, e.g. $$ or $varName.\nBut ' followed by ' is special, as is $ followed by {.\nIf you want them, use anti-quotations: '', \${.\n Tabs are not interpreted as whitespace (since we can't guess\n what tab settings are intended), so don't use them.\n\tThis line starts with a space and a tab, so only one\n space will be stripped from each line.\nAlso note that if the last line (just before the closing ' ')\nconsists only of whitespace, it's ignored. But here there is\nsome non-whitespace stuff, so the line isn't removed. \nThis shows a hacky way to preserve an empty line after the start.\nBut there's no reason to do so: you could just repeat the empty\nline.\n Similarly you can force an indentation level,\n in this case to 2 spaces. This works because the anti-quote\n is significant (not whitespace).\nstart on network-interfaces\n\nstart script\n\n rm -f /var/run/opengl-driver\n ln -sf 123 /var/run/opengl-driver\n\n rm -f /var/log/slim.log\n \nend script\n\nenv SLIM_CFGFILE=abc\nenv SLIM_THEMESDIR=def\nenv FONTCONFIG_FILE=/etc/fonts/fonts.conf \t\t\t\t# !!! cleanup\nenv XKB_BINDIR=foo/bin \t\t\t\t# Needed for the Xkb extension.\nenv LD_LIBRARY_PATH=libX11/lib:libXext/lib:/usr/lib/ # related to xorg-sys-opengl - needed to load libglx for (AI)GLX support (for compiz)\n\nenv XORG_DRI_DRIVER_PATH=nvidiaDrivers/X11R6/lib/modules/drivers/ \n\nexec slim/bin/slim\nEscaping of ' followed by ': ''\nEscaping of $ followed by {: \${\nAnd finally to interpret \\n etc. as in a string: \n, \r, \t.\nfoo\n'bla'\nbar\ncut -d $'\\t' -f 1\nending dollar $$\n" | |||
diff --git a/test/testdata/eval-okay-ind-string.nix b/test/testdata/eval-okay-ind-string.nix new file mode 100644 index 0000000..95d59b5 --- /dev/null +++ b/test/testdata/eval-okay-ind-string.nix | |||
@@ -0,0 +1,128 @@ | |||
1 | let | ||
2 | |||
3 | s1 = '' | ||
4 | This is an indented multi-line string | ||
5 | literal. An amount of whitespace at | ||
6 | the start of each line matching the minimum | ||
7 | indentation of all lines in the string | ||
8 | literal together will be removed. Thus, | ||
9 | in this case four spaces will be | ||
10 | stripped from each line, even though | ||
11 | THIS LINE is indented six spaces. | ||
12 | |||
13 | Also, empty lines don't count in the | ||
14 | determination of the indentation level (the | ||
15 | previous empty line has indentation 0, but | ||
16 | it doesn't matter). | ||
17 | ''; | ||
18 | |||
19 | s2 = '' If the string starts with whitespace | ||
20 | followed by a newline, it's stripped, but | ||
21 | that's not the case here. Two spaces are | ||
22 | stripped because of the " " at the start. | ||
23 | ''; | ||
24 | |||
25 | s3 = '' | ||
26 | This line is indented | ||
27 | a bit further. | ||
28 | ''; # indentation of last line doesn't count if it's empty | ||
29 | |||
30 | s4 = '' | ||
31 | Anti-quotations, like ${if true then "so" else "not so"}, are | ||
32 | also allowed. | ||
33 | ''; | ||
34 | |||
35 | s5 = '' | ||
36 | The \ is not special here. | ||
37 | ' can be followed by any character except another ', e.g. 'x'. | ||
38 | Likewise for $, e.g. $$ or $varName. | ||
39 | But ' followed by ' is special, as is $ followed by {. | ||
40 | If you want them, use anti-quotations: ${"''"}, ${"\${"}. | ||
41 | ''; | ||
42 | |||
43 | s6 = '' | ||
44 | Tabs are not interpreted as whitespace (since we can't guess | ||
45 | what tab settings are intended), so don't use them. | ||
46 | This line starts with a space and a tab, so only one | ||
47 | space will be stripped from each line. | ||
48 | ''; | ||
49 | |||
50 | s7 = '' | ||
51 | Also note that if the last line (just before the closing ' ') | ||
52 | consists only of whitespace, it's ignored. But here there is | ||
53 | some non-whitespace stuff, so the line isn't removed. ''; | ||
54 | |||
55 | s8 = '' ${""} | ||
56 | This shows a hacky way to preserve an empty line after the start. | ||
57 | But there's no reason to do so: you could just repeat the empty | ||
58 | line. | ||
59 | ''; | ||
60 | |||
61 | s9 = '' | ||
62 | ${""} Similarly you can force an indentation level, | ||
63 | in this case to 2 spaces. This works because the anti-quote | ||
64 | is significant (not whitespace). | ||
65 | ''; | ||
66 | |||
67 | s10 = '' | ||
68 | ''; | ||
69 | |||
70 | s11 = ''''; | ||
71 | |||
72 | s12 = '' ''; | ||
73 | |||
74 | s13 = '' | ||
75 | start on network-interfaces | ||
76 | |||
77 | start script | ||
78 | |||
79 | rm -f /var/run/opengl-driver | ||
80 | ${if true | ||
81 | then "ln -sf 123 /var/run/opengl-driver" | ||
82 | else if true | ||
83 | then "ln -sf 456 /var/run/opengl-driver" | ||
84 | else "" | ||
85 | } | ||
86 | |||
87 | rm -f /var/log/slim.log | ||
88 | |||
89 | end script | ||
90 | |||
91 | env SLIM_CFGFILE=${"abc"} | ||
92 | env SLIM_THEMESDIR=${"def"} | ||
93 | env FONTCONFIG_FILE=/etc/fonts/fonts.conf # !!! cleanup | ||
94 | env XKB_BINDIR=${"foo"}/bin # Needed for the Xkb extension. | ||
95 | env LD_LIBRARY_PATH=${"libX11"}/lib:${"libXext"}/lib:/usr/lib/ # related to xorg-sys-opengl - needed to load libglx for (AI)GLX support (for compiz) | ||
96 | |||
97 | ${if true | ||
98 | then "env XORG_DRI_DRIVER_PATH=${"nvidiaDrivers"}/X11R6/lib/modules/drivers/" | ||
99 | else if true | ||
100 | then "env XORG_DRI_DRIVER_PATH=${"mesa"}/lib/modules/dri" | ||
101 | else "" | ||
102 | } | ||
103 | |||
104 | exec ${"slim"}/bin/slim | ||
105 | ''; | ||
106 | |||
107 | s14 = '' | ||
108 | Escaping of ' followed by ': ''' | ||
109 | Escaping of $ followed by {: ''${ | ||
110 | And finally to interpret \n etc. as in a string: ''\n, ''\r, ''\t. | ||
111 | ''; | ||
112 | |||
113 | # Regression test: string interpolation in '${x}' should work, but didn't. | ||
114 | s15 = let x = "bla"; in '' | ||
115 | foo | ||
116 | '${x}' | ||
117 | bar | ||
118 | ''; | ||
119 | |||
120 | # Regression test: accept $'. | ||
121 | s16 = '' | ||
122 | cut -d $'\t' -f 1 | ||
123 | ''; | ||
124 | |||
125 | # Accept dollars at end of strings | ||
126 | s17 = ''ending dollar $'' + ''$'' + "\n"; | ||
127 | |||
128 | in s1 + s2 + s3 + s4 + s5 + s6 + s7 + s8 + s9 + s10 + s11 + s12 + s13 + s14 + s15 + s16 + s17 | ||
diff --git a/test/testdata/eval-okay-inherit-attr-pos.exp b/test/testdata/eval-okay-inherit-attr-pos.exp new file mode 100644 index 0000000..e87d037 --- /dev/null +++ b/test/testdata/eval-okay-inherit-attr-pos.exp | |||
@@ -0,0 +1 @@ | |||
[ { column = 17; file = "/pwd/lang/eval-okay-inherit-attr-pos.nix"; line = 4; } { column = 19; file = "/pwd/lang/eval-okay-inherit-attr-pos.nix"; line = 4; } { column = 21; file = "/pwd/lang/eval-okay-inherit-attr-pos.nix"; line = 5; } { column = 23; file = "/pwd/lang/eval-okay-inherit-attr-pos.nix"; line = 5; } ] | |||
diff --git a/test/testdata/eval-okay-inherit-attr-pos.nix b/test/testdata/eval-okay-inherit-attr-pos.nix new file mode 100644 index 0000000..017ab1d --- /dev/null +++ b/test/testdata/eval-okay-inherit-attr-pos.nix | |||
@@ -0,0 +1,12 @@ | |||
1 | let | ||
2 | d = 0; | ||
3 | x = 1; | ||
4 | y = { inherit d x; }; | ||
5 | z = { inherit (y) d x; }; | ||
6 | in | ||
7 | [ | ||
8 | (builtins.unsafeGetAttrPos "d" y) | ||
9 | (builtins.unsafeGetAttrPos "x" y) | ||
10 | (builtins.unsafeGetAttrPos "d" z) | ||
11 | (builtins.unsafeGetAttrPos "x" z) | ||
12 | ] | ||
diff --git a/test/testdata/eval-okay-inherit-from.err.exp b/test/testdata/eval-okay-inherit-from.err.exp new file mode 100644 index 0000000..3227501 --- /dev/null +++ b/test/testdata/eval-okay-inherit-from.err.exp | |||
@@ -0,0 +1 @@ | |||
trace: used | |||
diff --git a/test/testdata/eval-okay-inherit-from.exp b/test/testdata/eval-okay-inherit-from.exp new file mode 100644 index 0000000..024daff --- /dev/null +++ b/test/testdata/eval-okay-inherit-from.exp | |||
@@ -0,0 +1 @@ | |||
[ 1 2 { __overrides = { y = { d = [ ]; }; }; c = [ ]; d = 4; x = { c = [ ]; }; y = «repeated»; } { inner = { c = 3; d = 4; }; } ] | |||
diff --git a/test/testdata/eval-okay-inherit-from.nix b/test/testdata/eval-okay-inherit-from.nix new file mode 100644 index 0000000..b72a1c6 --- /dev/null +++ b/test/testdata/eval-okay-inherit-from.nix | |||
@@ -0,0 +1,16 @@ | |||
1 | let | ||
2 | inherit (builtins.trace "used" { a = 1; b = 2; }) a b; | ||
3 | x.c = 3; | ||
4 | y.d = 4; | ||
5 | |||
6 | merged = { | ||
7 | inner = { | ||
8 | inherit (y) d; | ||
9 | }; | ||
10 | |||
11 | inner = { | ||
12 | inherit (x) c; | ||
13 | }; | ||
14 | }; | ||
15 | in | ||
16 | [ a b rec { x.c = []; inherit (x) c; inherit (y) d; __overrides.y.d = []; } merged ] | ||
diff --git a/test/testdata/eval-okay-intersectAttrs.exp b/test/testdata/eval-okay-intersectAttrs.exp new file mode 100644 index 0000000..50445bc --- /dev/null +++ b/test/testdata/eval-okay-intersectAttrs.exp | |||
@@ -0,0 +1 @@ | |||
[ { } { a = 1; } { a = 1; } { a = "a"; } { m = 1; } { m = "m"; } { n = 1; } { n = "n"; } { n = 1; p = 2; } { n = "n"; p = "p"; } { n = 1; p = 2; } { n = "n"; p = "p"; } { a = "a"; b = "b"; c = "c"; d = "d"; e = "e"; f = "f"; g = "g"; h = "h"; i = "i"; j = "j"; k = "k"; l = "l"; m = "m"; n = "n"; o = "o"; p = "p"; q = "q"; r = "r"; s = "s"; t = "t"; u = "u"; v = "v"; w = "w"; x = "x"; y = "y"; z = "z"; } true ] | |||
diff --git a/test/testdata/eval-okay-intersectAttrs.nix b/test/testdata/eval-okay-intersectAttrs.nix new file mode 100644 index 0000000..39d4993 --- /dev/null +++ b/test/testdata/eval-okay-intersectAttrs.nix | |||
@@ -0,0 +1,50 @@ | |||
1 | let | ||
2 | alphabet = | ||
3 | { a = "a"; | ||
4 | b = "b"; | ||
5 | c = "c"; | ||
6 | d = "d"; | ||
7 | e = "e"; | ||
8 | f = "f"; | ||
9 | g = "g"; | ||
10 | h = "h"; | ||
11 | i = "i"; | ||
12 | j = "j"; | ||
13 | k = "k"; | ||
14 | l = "l"; | ||
15 | m = "m"; | ||
16 | n = "n"; | ||
17 | o = "o"; | ||
18 | p = "p"; | ||
19 | q = "q"; | ||
20 | r = "r"; | ||
21 | s = "s"; | ||
22 | t = "t"; | ||
23 | u = "u"; | ||
24 | v = "v"; | ||
25 | w = "w"; | ||
26 | x = "x"; | ||
27 | y = "y"; | ||
28 | z = "z"; | ||
29 | }; | ||
30 | foo = { | ||
31 | inherit (alphabet) f o b a r z q u x; | ||
32 | aa = throw "aa"; | ||
33 | }; | ||
34 | alphabetFail = builtins.mapAttrs throw alphabet; | ||
35 | in | ||
36 | [ (builtins.intersectAttrs { a = abort "l1"; } { b = abort "r1"; }) | ||
37 | (builtins.intersectAttrs { a = abort "l2"; } { a = 1; }) | ||
38 | (builtins.intersectAttrs alphabetFail { a = 1; }) | ||
39 | (builtins.intersectAttrs { a = abort "laa"; } alphabet) | ||
40 | (builtins.intersectAttrs alphabetFail { m = 1; }) | ||
41 | (builtins.intersectAttrs { m = abort "lam"; } alphabet) | ||
42 | (builtins.intersectAttrs alphabetFail { n = 1; }) | ||
43 | (builtins.intersectAttrs { n = abort "lan"; } alphabet) | ||
44 | (builtins.intersectAttrs alphabetFail { n = 1; p = 2; }) | ||
45 | (builtins.intersectAttrs { n = abort "lan2"; p = abort "lap"; } alphabet) | ||
46 | (builtins.intersectAttrs alphabetFail { n = 1; p = 2; }) | ||
47 | (builtins.intersectAttrs { n = abort "lan2"; p = abort "lap"; } alphabet) | ||
48 | (builtins.intersectAttrs alphabetFail alphabet) | ||
49 | (builtins.intersectAttrs alphabet foo == builtins.intersectAttrs foo alphabet) | ||
50 | ] | ||
diff --git a/test/testdata/eval-okay-let.exp b/test/testdata/eval-okay-let.exp new file mode 100644 index 0000000..14e24d4 --- /dev/null +++ b/test/testdata/eval-okay-let.exp | |||
@@ -0,0 +1 @@ | |||
"foobar" | |||
diff --git a/test/testdata/eval-okay-let.nix b/test/testdata/eval-okay-let.nix new file mode 100644 index 0000000..fe118c5 --- /dev/null +++ b/test/testdata/eval-okay-let.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | let { | ||
2 | x = "foo"; | ||
3 | y = "bar"; | ||
4 | body = x + y; | ||
5 | } | ||
diff --git a/test/testdata/eval-okay-list.exp b/test/testdata/eval-okay-list.exp new file mode 100644 index 0000000..f784f26 --- /dev/null +++ b/test/testdata/eval-okay-list.exp | |||
@@ -0,0 +1 @@ | |||
"foobarblatest" | |||
diff --git a/test/testdata/eval-okay-list.nix b/test/testdata/eval-okay-list.nix new file mode 100644 index 0000000..d433bcf --- /dev/null +++ b/test/testdata/eval-okay-list.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | let { | ||
4 | |||
5 | body = concat ["foo" "bar" "bla" "test"]; | ||
6 | |||
7 | } \ No newline at end of file | ||
diff --git a/test/testdata/eval-okay-listtoattrs.exp b/test/testdata/eval-okay-listtoattrs.exp new file mode 100644 index 0000000..74abef7 --- /dev/null +++ b/test/testdata/eval-okay-listtoattrs.exp | |||
@@ -0,0 +1 @@ | |||
"AAbar" | |||
diff --git a/test/testdata/eval-okay-listtoattrs.nix b/test/testdata/eval-okay-listtoattrs.nix new file mode 100644 index 0000000..4186e02 --- /dev/null +++ b/test/testdata/eval-okay-listtoattrs.nix | |||
@@ -0,0 +1,11 @@ | |||
1 | # this test shows how to use listToAttrs and that evaluation is still lazy (throw isn't called) | ||
2 | with import ./lib.nix; | ||
3 | |||
4 | let | ||
5 | asi = name: value : { inherit name value; }; | ||
6 | list = [ ( asi "a" "A" ) ( asi "b" "B" ) ]; | ||
7 | a = builtins.listToAttrs list; | ||
8 | b = builtins.listToAttrs ( list ++ list ); | ||
9 | r = builtins.listToAttrs [ (asi "result" [ a b ]) ( asi "throw" (throw "this should not be thrown")) ]; | ||
10 | x = builtins.listToAttrs [ (asi "foo" "bar") (asi "foo" "bla") ]; | ||
11 | in concat (map (x: x.a) r.result) + x.foo | ||
diff --git a/test/testdata/eval-okay-logic.exp b/test/testdata/eval-okay-logic.exp new file mode 100644 index 0000000..d00491f --- /dev/null +++ b/test/testdata/eval-okay-logic.exp | |||
@@ -0,0 +1 @@ | |||
1 | |||
diff --git a/test/testdata/eval-okay-logic.nix b/test/testdata/eval-okay-logic.nix new file mode 100644 index 0000000..fbb1279 --- /dev/null +++ b/test/testdata/eval-okay-logic.nix | |||
@@ -0,0 +1 @@ | |||
assert !false && (true || false) -> true; 1 | |||
diff --git a/test/testdata/eval-okay-map.exp b/test/testdata/eval-okay-map.exp new file mode 100644 index 0000000..dbb64f7 --- /dev/null +++ b/test/testdata/eval-okay-map.exp | |||
@@ -0,0 +1 @@ | |||
"foobarblabarxyzzybar" | |||
diff --git a/test/testdata/eval-okay-map.nix b/test/testdata/eval-okay-map.nix new file mode 100644 index 0000000..a76c1d8 --- /dev/null +++ b/test/testdata/eval-okay-map.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | concat (map (x: x + "bar") [ "foo" "bla" "xyzzy" ]) \ No newline at end of file | ||
diff --git a/test/testdata/eval-okay-mapattrs.exp b/test/testdata/eval-okay-mapattrs.exp new file mode 100644 index 0000000..3f113f1 --- /dev/null +++ b/test/testdata/eval-okay-mapattrs.exp | |||
@@ -0,0 +1 @@ | |||
{ x = "x-foo"; y = "y-bar"; } | |||
diff --git a/test/testdata/eval-okay-mapattrs.nix b/test/testdata/eval-okay-mapattrs.nix new file mode 100644 index 0000000..f075b62 --- /dev/null +++ b/test/testdata/eval-okay-mapattrs.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | builtins.mapAttrs (name: value: name + "-" + value) { x = "foo"; y = "bar"; } | ||
diff --git a/test/testdata/eval-okay-merge-dynamic-attrs.exp b/test/testdata/eval-okay-merge-dynamic-attrs.exp new file mode 100644 index 0000000..157d677 --- /dev/null +++ b/test/testdata/eval-okay-merge-dynamic-attrs.exp | |||
@@ -0,0 +1 @@ | |||
{ set1 = { a = 1; b = 2; }; set2 = { a = 1; b = 2; }; set3 = { a = 1; b = 2; }; set4 = { a = 1; b = 2; }; } | |||
diff --git a/test/testdata/eval-okay-merge-dynamic-attrs.nix b/test/testdata/eval-okay-merge-dynamic-attrs.nix new file mode 100644 index 0000000..f459a55 --- /dev/null +++ b/test/testdata/eval-okay-merge-dynamic-attrs.nix | |||
@@ -0,0 +1,13 @@ | |||
1 | { | ||
2 | set1 = { a = 1; }; | ||
3 | set1 = { "${"b" + ""}" = 2; }; | ||
4 | |||
5 | set2 = { "${"b" + ""}" = 2; }; | ||
6 | set2 = { a = 1; }; | ||
7 | |||
8 | set3.a = 1; | ||
9 | set3."${"b" + ""}" = 2; | ||
10 | |||
11 | set4."${"b" + ""}" = 2; | ||
12 | set4.a = 1; | ||
13 | } | ||
diff --git a/test/testdata/eval-okay-nested-with.exp b/test/testdata/eval-okay-nested-with.exp new file mode 100644 index 0000000..0cfbf08 --- /dev/null +++ b/test/testdata/eval-okay-nested-with.exp | |||
@@ -0,0 +1 @@ | |||
2 | |||
diff --git a/test/testdata/eval-okay-nested-with.nix b/test/testdata/eval-okay-nested-with.nix new file mode 100644 index 0000000..ba9d79a --- /dev/null +++ b/test/testdata/eval-okay-nested-with.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | with { x = 1; }; | ||
2 | with { x = 2; }; | ||
3 | x | ||
diff --git a/test/testdata/eval-okay-new-let.exp b/test/testdata/eval-okay-new-let.exp new file mode 100644 index 0000000..f98b388 --- /dev/null +++ b/test/testdata/eval-okay-new-let.exp | |||
@@ -0,0 +1 @@ | |||
"xyzzyfoobar" | |||
diff --git a/test/testdata/eval-okay-new-let.nix b/test/testdata/eval-okay-new-let.nix new file mode 100644 index 0000000..7381231 --- /dev/null +++ b/test/testdata/eval-okay-new-let.nix | |||
@@ -0,0 +1,14 @@ | |||
1 | let | ||
2 | |||
3 | f = z: | ||
4 | |||
5 | let | ||
6 | x = "foo"; | ||
7 | y = "bar"; | ||
8 | body = 1; # compat test | ||
9 | in | ||
10 | z + x + y; | ||
11 | |||
12 | arg = "xyzzy"; | ||
13 | |||
14 | in f arg | ||
diff --git a/test/testdata/eval-okay-null-dynamic-attrs.exp b/test/testdata/eval-okay-null-dynamic-attrs.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-null-dynamic-attrs.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-null-dynamic-attrs.nix b/test/testdata/eval-okay-null-dynamic-attrs.nix new file mode 100644 index 0000000..b060c0b --- /dev/null +++ b/test/testdata/eval-okay-null-dynamic-attrs.nix | |||
@@ -0,0 +1 @@ | |||
{ ${null} = true; } == {} | |||
diff --git a/test/testdata/eval-okay-overrides.exp b/test/testdata/eval-okay-overrides.exp new file mode 100644 index 0000000..0cfbf08 --- /dev/null +++ b/test/testdata/eval-okay-overrides.exp | |||
@@ -0,0 +1 @@ | |||
2 | |||
diff --git a/test/testdata/eval-okay-overrides.nix b/test/testdata/eval-okay-overrides.nix new file mode 100644 index 0000000..719bdc9 --- /dev/null +++ b/test/testdata/eval-okay-overrides.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | let | ||
2 | |||
3 | overrides = { a = 2; b = 3; }; | ||
4 | |||
5 | in (rec { | ||
6 | __overrides = overrides; | ||
7 | x = a; | ||
8 | a = 1; | ||
9 | }).x | ||
diff --git a/test/testdata/eval-okay-parse-flake-ref.exp b/test/testdata/eval-okay-parse-flake-ref.exp new file mode 100644 index 0000000..fc17ba0 --- /dev/null +++ b/test/testdata/eval-okay-parse-flake-ref.exp | |||
@@ -0,0 +1 @@ | |||
{ dir = "lib"; owner = "NixOS"; ref = "23.05"; repo = "nixpkgs"; type = "github"; } | |||
diff --git a/test/testdata/eval-okay-parse-flake-ref.nix b/test/testdata/eval-okay-parse-flake-ref.nix new file mode 100644 index 0000000..db4ed27 --- /dev/null +++ b/test/testdata/eval-okay-parse-flake-ref.nix | |||
@@ -0,0 +1 @@ | |||
builtins.parseFlakeRef "github:NixOS/nixpkgs/23.05?dir=lib" | |||
diff --git a/test/testdata/eval-okay-partition.exp b/test/testdata/eval-okay-partition.exp new file mode 100644 index 0000000..cd8b8b0 --- /dev/null +++ b/test/testdata/eval-okay-partition.exp | |||
@@ -0,0 +1 @@ | |||
{ right = [ 0 2 4 6 8 10 100 102 104 106 108 110 ]; wrong = [ 1 3 5 7 9 101 103 105 107 109 ]; } | |||
diff --git a/test/testdata/eval-okay-partition.nix b/test/testdata/eval-okay-partition.nix new file mode 100644 index 0000000..846d2ce --- /dev/null +++ b/test/testdata/eval-okay-partition.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | builtins.partition | ||
4 | (x: x / 2 * 2 == x) | ||
5 | (builtins.concatLists [ (range 0 10) (range 100 110) ]) | ||
diff --git a/test/testdata/eval-okay-path-string-interpolation.exp b/test/testdata/eval-okay-path-string-interpolation.exp new file mode 100644 index 0000000..5b8ea02 --- /dev/null +++ b/test/testdata/eval-okay-path-string-interpolation.exp | |||
@@ -0,0 +1 @@ | |||
{ absolute = /foo; expr = /pwd/lang/foo/bar; home = /fake-home/foo; notfirst = /pwd/lang/bar/foo; simple = /pwd/lang/foo; slashes = /foo/bar; surrounded = /pwd/lang/a-foo-b; } | |||
diff --git a/test/testdata/eval-okay-path-string-interpolation.nix b/test/testdata/eval-okay-path-string-interpolation.nix new file mode 100644 index 0000000..497d7c1 --- /dev/null +++ b/test/testdata/eval-okay-path-string-interpolation.nix | |||
@@ -0,0 +1,12 @@ | |||
1 | let | ||
2 | foo = "foo"; | ||
3 | in | ||
4 | { | ||
5 | simple = ./${foo}; | ||
6 | surrounded = ./a-${foo}-b; | ||
7 | absolute = /${foo}; | ||
8 | expr = ./${foo + "/bar"}; | ||
9 | home = ~/${foo}; | ||
10 | notfirst = ./bar/${foo}; | ||
11 | slashes = /${foo}/${"bar"}; | ||
12 | } | ||
diff --git a/test/testdata/eval-okay-path.exp b/test/testdata/eval-okay-path.exp new file mode 100644 index 0000000..635e224 --- /dev/null +++ b/test/testdata/eval-okay-path.exp | |||
@@ -0,0 +1 @@ | |||
[ "/nix/store/ya937r4ydw0l6kayq8jkyqaips9c75jm-output" "/nix/store/m7y372g6jb0g4hh1dzmj847rd356fhnz-output" ] | |||
diff --git a/test/testdata/eval-okay-path.nix b/test/testdata/eval-okay-path.nix new file mode 100644 index 0000000..599b335 --- /dev/null +++ b/test/testdata/eval-okay-path.nix | |||
@@ -0,0 +1,15 @@ | |||
1 | [ | ||
2 | (builtins.path | ||
3 | { path = ./.; | ||
4 | filter = path: _: baseNameOf path == "data"; | ||
5 | recursive = true; | ||
6 | sha256 = "1yhm3gwvg5a41yylymgblsclk95fs6jy72w0wv925mmidlhcq4sw"; | ||
7 | name = "output"; | ||
8 | }) | ||
9 | (builtins.path | ||
10 | { path = ./data; | ||
11 | recursive = false; | ||
12 | sha256 = "0k4lwj58f2w5yh92ilrwy9917pycipbrdrr13vbb3yd02j09vfxm"; | ||
13 | name = "output"; | ||
14 | }) | ||
15 | ] | ||
diff --git a/test/testdata/eval-okay-pathexists.exp b/test/testdata/eval-okay-pathexists.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-pathexists.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-pathexists.nix b/test/testdata/eval-okay-pathexists.nix new file mode 100644 index 0000000..022b22f --- /dev/null +++ b/test/testdata/eval-okay-pathexists.nix | |||
@@ -0,0 +1,34 @@ | |||
1 | builtins.pathExists (./lib.nix) | ||
2 | && builtins.pathExists (builtins.toPath ./lib.nix) | ||
3 | && builtins.pathExists (builtins.toString ./lib.nix) | ||
4 | && !builtins.pathExists (builtins.toString ./lib.nix + "/") | ||
5 | && !builtins.pathExists (builtins.toString ./lib.nix + "/.") | ||
6 | # FIXME | ||
7 | # && !builtins.pathExists (builtins.toString ./lib.nix + "/..") | ||
8 | # && !builtins.pathExists (builtins.toString ./lib.nix + "/a/..") | ||
9 | # && !builtins.pathExists (builtins.toString ./lib.nix + "/../lib.nix") | ||
10 | && !builtins.pathExists (builtins.toString ./lib.nix + "/./") | ||
11 | && !builtins.pathExists (builtins.toString ./lib.nix + "/./.") | ||
12 | && builtins.pathExists (builtins.toString ./.. + "/lang/lib.nix") | ||
13 | && !builtins.pathExists (builtins.toString ./.. + "lang/lib.nix") | ||
14 | && builtins.pathExists (builtins.toString ./. + "/../lang/lib.nix") | ||
15 | && builtins.pathExists (builtins.toString ./. + "/../lang/./lib.nix") | ||
16 | && builtins.pathExists (builtins.toString ./.) | ||
17 | && builtins.pathExists (builtins.toString ./. + "/") | ||
18 | && builtins.pathExists (builtins.toString ./. + "/../lang") | ||
19 | && builtins.pathExists (builtins.toString ./. + "/../lang/") | ||
20 | && builtins.pathExists (builtins.toString ./. + "/../lang/.") | ||
21 | && builtins.pathExists (builtins.toString ./. + "/../lang/./") | ||
22 | && builtins.pathExists (builtins.toString ./. + "/../lang//./") | ||
23 | && builtins.pathExists (builtins.toString ./. + "/../lang/..") | ||
24 | && builtins.pathExists (builtins.toString ./. + "/../lang/../") | ||
25 | && builtins.pathExists (builtins.toString ./. + "/../lang/..//") | ||
26 | && builtins.pathExists (builtins.toPath (builtins.toString ./lib.nix)) | ||
27 | && !builtins.pathExists (builtins.toPath (builtins.toString ./bla.nix)) | ||
28 | && builtins.pathExists (builtins.toPath { __toString = x: builtins.toString ./lib.nix; }) | ||
29 | && builtins.pathExists (builtins.toPath { outPath = builtins.toString ./lib.nix; }) | ||
30 | && builtins.pathExists ./lib.nix | ||
31 | && !builtins.pathExists ./bla.nix | ||
32 | && builtins.pathExists ./symlink-resolution/foo/overlays/overlay.nix | ||
33 | && builtins.pathExists ./symlink-resolution/broken | ||
34 | && builtins.pathExists (builtins.toString ./symlink-resolution/foo/overlays + "/.") | ||
diff --git a/test/testdata/eval-okay-patterns.exp b/test/testdata/eval-okay-patterns.exp new file mode 100644 index 0000000..a430401 --- /dev/null +++ b/test/testdata/eval-okay-patterns.exp | |||
@@ -0,0 +1 @@ | |||
"abcxyzDDDDEFijk" | |||
diff --git a/test/testdata/eval-okay-patterns.nix b/test/testdata/eval-okay-patterns.nix new file mode 100644 index 0000000..96fd25a --- /dev/null +++ b/test/testdata/eval-okay-patterns.nix | |||
@@ -0,0 +1,16 @@ | |||
1 | let | ||
2 | |||
3 | f = args@{x, y, z}: x + args.y + z; | ||
4 | |||
5 | g = {x, y, z}@args: f args; | ||
6 | |||
7 | h = {x ? "d", y ? x, z ? args.x}@args: x + y + z; | ||
8 | |||
9 | j = {x, y, z, ...}: x + y + z; | ||
10 | |||
11 | in | ||
12 | f {x = "a"; y = "b"; z = "c";} + | ||
13 | g {x = "x"; y = "y"; z = "z";} + | ||
14 | h {x = "D";} + | ||
15 | h {x = "D"; y = "E"; z = "F";} + | ||
16 | j {x = "i"; y = "j"; z = "k"; bla = "bla"; foo = "bar";} | ||
diff --git a/test/testdata/eval-okay-print.err.exp b/test/testdata/eval-okay-print.err.exp new file mode 100644 index 0000000..80aa17c --- /dev/null +++ b/test/testdata/eval-okay-print.err.exp | |||
@@ -0,0 +1 @@ | |||
trace: [ «thunk» ] | |||
diff --git a/test/testdata/eval-okay-print.exp b/test/testdata/eval-okay-print.exp new file mode 100644 index 0000000..0d960fb --- /dev/null +++ b/test/testdata/eval-okay-print.exp | |||
@@ -0,0 +1 @@ | |||
[ null <PRIMOP> <PRIMOP-APP> <LAMBDA> [ [ «repeated» ] ] ] | |||
diff --git a/test/testdata/eval-okay-print.nix b/test/testdata/eval-okay-print.nix new file mode 100644 index 0000000..d36ba4d --- /dev/null +++ b/test/testdata/eval-okay-print.nix | |||
@@ -0,0 +1 @@ | |||
with builtins; trace [(1+1)] [ null toString (deepSeq "x") (a: a) (let x=[x]; in x) ] | |||
diff --git a/test/testdata/eval-okay-readDir.exp b/test/testdata/eval-okay-readDir.exp new file mode 100644 index 0000000..6413f6d --- /dev/null +++ b/test/testdata/eval-okay-readDir.exp | |||
@@ -0,0 +1 @@ | |||
{ bar = "regular"; foo = "directory"; ldir = "symlink"; linked = "symlink"; } | |||
diff --git a/test/testdata/eval-okay-readDir.nix b/test/testdata/eval-okay-readDir.nix new file mode 100644 index 0000000..a7ec929 --- /dev/null +++ b/test/testdata/eval-okay-readDir.nix | |||
@@ -0,0 +1 @@ | |||
builtins.readDir ./readDir | |||
diff --git a/test/testdata/eval-okay-readFileType.exp b/test/testdata/eval-okay-readFileType.exp new file mode 100644 index 0000000..6413f6d --- /dev/null +++ b/test/testdata/eval-okay-readFileType.exp | |||
@@ -0,0 +1 @@ | |||
{ bar = "regular"; foo = "directory"; ldir = "symlink"; linked = "symlink"; } | |||
diff --git a/test/testdata/eval-okay-readFileType.nix b/test/testdata/eval-okay-readFileType.nix new file mode 100644 index 0000000..174fb6c --- /dev/null +++ b/test/testdata/eval-okay-readFileType.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | { | ||
2 | bar = builtins.readFileType ./readDir/bar; | ||
3 | foo = builtins.readFileType ./readDir/foo; | ||
4 | linked = builtins.readFileType ./readDir/linked; | ||
5 | ldir = builtins.readFileType ./readDir/ldir; | ||
6 | } | ||
diff --git a/test/testdata/eval-okay-readfile.exp b/test/testdata/eval-okay-readfile.exp new file mode 100644 index 0000000..a2c87d0 --- /dev/null +++ b/test/testdata/eval-okay-readfile.exp | |||
@@ -0,0 +1 @@ | |||
"builtins.readFile ./eval-okay-readfile.nix\n" | |||
diff --git a/test/testdata/eval-okay-readfile.nix b/test/testdata/eval-okay-readfile.nix new file mode 100644 index 0000000..82f7cb1 --- /dev/null +++ b/test/testdata/eval-okay-readfile.nix | |||
@@ -0,0 +1 @@ | |||
builtins.readFile ./eval-okay-readfile.nix | |||
diff --git a/test/testdata/eval-okay-redefine-builtin.exp b/test/testdata/eval-okay-redefine-builtin.exp new file mode 100644 index 0000000..c508d53 --- /dev/null +++ b/test/testdata/eval-okay-redefine-builtin.exp | |||
@@ -0,0 +1 @@ | |||
false | |||
diff --git a/test/testdata/eval-okay-redefine-builtin.nix b/test/testdata/eval-okay-redefine-builtin.nix new file mode 100644 index 0000000..df9fc3f --- /dev/null +++ b/test/testdata/eval-okay-redefine-builtin.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | let | ||
2 | throw = abort "Error!"; | ||
3 | in (builtins.tryEval <foobaz>).success | ||
diff --git a/test/testdata/eval-okay-regex-match.exp b/test/testdata/eval-okay-regex-match.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-regex-match.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-regex-match.nix b/test/testdata/eval-okay-regex-match.nix new file mode 100644 index 0000000..273e259 --- /dev/null +++ b/test/testdata/eval-okay-regex-match.nix | |||
@@ -0,0 +1,29 @@ | |||
1 | with builtins; | ||
2 | |||
3 | let | ||
4 | |||
5 | matches = pat: s: match pat s != null; | ||
6 | |||
7 | splitFN = match "((.*)/)?([^/]*)\\.(nix|cc)"; | ||
8 | |||
9 | in | ||
10 | |||
11 | assert matches "foobar" "foobar"; | ||
12 | assert matches "fo*" "f"; | ||
13 | assert !matches "fo+" "f"; | ||
14 | assert matches "fo*" "fo"; | ||
15 | assert matches "fo*" "foo"; | ||
16 | assert matches "fo+" "foo"; | ||
17 | assert matches "fo{1,2}" "foo"; | ||
18 | assert !matches "fo{1,2}" "fooo"; | ||
19 | assert !matches "fo*" "foobar"; | ||
20 | assert matches "[[:space:]]+([^[:space:]]+)[[:space:]]+" " foo "; | ||
21 | assert !matches "[[:space:]]+([[:upper:]]+)[[:space:]]+" " foo "; | ||
22 | |||
23 | assert match "(.*)\\.nix" "foobar.nix" == [ "foobar" ]; | ||
24 | assert match "[[:space:]]+([[:upper:]]+)[[:space:]]+" " FOO " == [ "FOO" ]; | ||
25 | |||
26 | assert splitFN "/path/to/foobar.nix" == [ "/path/to/" "/path/to" "foobar" "nix" ]; | ||
27 | assert splitFN "foobar.cc" == [ null null "foobar" "cc" ]; | ||
28 | |||
29 | true | ||
diff --git a/test/testdata/eval-okay-regex-split.exp b/test/testdata/eval-okay-regex-split.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-regex-split.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-regex-split.nix b/test/testdata/eval-okay-regex-split.nix new file mode 100644 index 0000000..0073e05 --- /dev/null +++ b/test/testdata/eval-okay-regex-split.nix | |||
@@ -0,0 +1,48 @@ | |||
1 | with builtins; | ||
2 | |||
3 | # Non capturing regex returns empty lists | ||
4 | assert split "foobar" "foobar" == ["" [] ""]; | ||
5 | assert split "fo*" "f" == ["" [] ""]; | ||
6 | assert split "fo+" "f" == ["f"]; | ||
7 | assert split "fo*" "fo" == ["" [] ""]; | ||
8 | assert split "fo*" "foo" == ["" [] ""]; | ||
9 | assert split "fo+" "foo" == ["" [] ""]; | ||
10 | assert split "fo{1,2}" "foo" == ["" [] ""]; | ||
11 | assert split "fo{1,2}" "fooo" == ["" [] "o"]; | ||
12 | assert split "fo*" "foobar" == ["" [] "bar"]; | ||
13 | |||
14 | # Capturing regex returns a list of sub-matches | ||
15 | assert split "(fo*)" "f" == ["" ["f"] ""]; | ||
16 | assert split "(fo+)" "f" == ["f"]; | ||
17 | assert split "(fo*)" "fo" == ["" ["fo"] ""]; | ||
18 | assert split "(f)(o*)" "f" == ["" ["f" ""] ""]; | ||
19 | assert split "(f)(o*)" "foo" == ["" ["f" "oo"] ""]; | ||
20 | assert split "(fo+)" "foo" == ["" ["foo"] ""]; | ||
21 | assert split "(fo{1,2})" "foo" == ["" ["foo"] ""]; | ||
22 | assert split "(fo{1,2})" "fooo" == ["" ["foo"] "o"]; | ||
23 | assert split "(fo*)" "foobar" == ["" ["foo"] "bar"]; | ||
24 | |||
25 | # Matches are greedy. | ||
26 | assert split "(o+)" "oooofoooo" == ["" ["oooo"] "f" ["oooo"] ""]; | ||
27 | |||
28 | # Matches multiple times. | ||
29 | assert split "(b)" "foobarbaz" == ["foo" ["b"] "ar" ["b"] "az"]; | ||
30 | |||
31 | # Split large strings containing newlines. null are inserted when a | ||
32 | # pattern within the current did not match anything. | ||
33 | assert split "[[:space:]]+|([',.!?])" '' | ||
34 | Nix Rocks! | ||
35 | That's why I use it. | ||
36 | '' == [ | ||
37 | "Nix" [ null ] "Rocks" ["!"] "" [ null ] | ||
38 | "That" ["'"] "s" [ null ] "why" [ null ] "I" [ null ] "use" [ null ] "it" ["."] "" [ null ] | ||
39 | "" | ||
40 | ]; | ||
41 | |||
42 | # Documentation examples | ||
43 | assert split "(a)b" "abc" == [ "" [ "a" ] "c" ]; | ||
44 | assert split "([ac])" "abc" == [ "" [ "a" ] "b" [ "c" ] "" ]; | ||
45 | assert split "(a)|(c)" "abc" == [ "" [ "a" null ] "b" [ null "c" ] "" ]; | ||
46 | assert split "([[:upper:]]+)" " FOO " == [ " " [ "FOO" ] " " ]; | ||
47 | |||
48 | true | ||
diff --git a/test/testdata/eval-okay-regression-20220122.exp b/test/testdata/eval-okay-regression-20220122.exp new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/test/testdata/eval-okay-regression-20220122.exp | |||
@@ -0,0 +1 @@ | |||
3 | |||
diff --git a/test/testdata/eval-okay-regression-20220122.nix b/test/testdata/eval-okay-regression-20220122.nix new file mode 100644 index 0000000..694e9a1 --- /dev/null +++ b/test/testdata/eval-okay-regression-20220122.nix | |||
@@ -0,0 +1 @@ | |||
((_: _) 1) + ((__: __) 2) | |||
diff --git a/test/testdata/eval-okay-regression-20220125.exp b/test/testdata/eval-okay-regression-20220125.exp new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/test/testdata/eval-okay-regression-20220125.exp | |||
@@ -0,0 +1 @@ | |||
3 | |||
diff --git a/test/testdata/eval-okay-regression-20220125.nix b/test/testdata/eval-okay-regression-20220125.nix new file mode 100644 index 0000000..4855023 --- /dev/null +++ b/test/testdata/eval-okay-regression-20220125.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | ((__curPosFoo: __curPosFoo) 1) + ((__curPosBar: __curPosBar) 2) | ||
2 | |||
diff --git a/test/testdata/eval-okay-remove.exp b/test/testdata/eval-okay-remove.exp new file mode 100644 index 0000000..8d38505 --- /dev/null +++ b/test/testdata/eval-okay-remove.exp | |||
@@ -0,0 +1 @@ | |||
456 | |||
diff --git a/test/testdata/eval-okay-remove.nix b/test/testdata/eval-okay-remove.nix new file mode 100644 index 0000000..4ad5ba8 --- /dev/null +++ b/test/testdata/eval-okay-remove.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | let { | ||
2 | attrs = {x = 123; y = 456;}; | ||
3 | |||
4 | body = (removeAttrs attrs ["x"]).y; | ||
5 | } \ No newline at end of file | ||
diff --git a/test/testdata/eval-okay-repeated-empty-attrs.exp b/test/testdata/eval-okay-repeated-empty-attrs.exp new file mode 100644 index 0000000..d21e6db --- /dev/null +++ b/test/testdata/eval-okay-repeated-empty-attrs.exp | |||
@@ -0,0 +1 @@ | |||
[ { } { } ] | |||
diff --git a/test/testdata/eval-okay-repeated-empty-attrs.nix b/test/testdata/eval-okay-repeated-empty-attrs.nix new file mode 100644 index 0000000..030a3b8 --- /dev/null +++ b/test/testdata/eval-okay-repeated-empty-attrs.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | # Tests that empty attribute sets are not printed as `«repeated»`. | ||
2 | [ {} {} ] | ||
diff --git a/test/testdata/eval-okay-repeated-empty-list.exp b/test/testdata/eval-okay-repeated-empty-list.exp new file mode 100644 index 0000000..701fc7e --- /dev/null +++ b/test/testdata/eval-okay-repeated-empty-list.exp | |||
@@ -0,0 +1 @@ | |||
[ [ ] [ ] ] | |||
diff --git a/test/testdata/eval-okay-repeated-empty-list.nix b/test/testdata/eval-okay-repeated-empty-list.nix new file mode 100644 index 0000000..376c51b --- /dev/null +++ b/test/testdata/eval-okay-repeated-empty-list.nix | |||
@@ -0,0 +1 @@ | |||
[ [] [] ] | |||
diff --git a/test/testdata/eval-okay-replacestrings.exp b/test/testdata/eval-okay-replacestrings.exp new file mode 100644 index 0000000..eac67c5 --- /dev/null +++ b/test/testdata/eval-okay-replacestrings.exp | |||
@@ -0,0 +1 @@ | |||
[ "faabar" "fbar" "fubar" "faboor" "fubar" "XaXbXcX" "X" "a_b" "fubar" ] | |||
diff --git a/test/testdata/eval-okay-replacestrings.nix b/test/testdata/eval-okay-replacestrings.nix new file mode 100644 index 0000000..a803e65 --- /dev/null +++ b/test/testdata/eval-okay-replacestrings.nix | |||
@@ -0,0 +1,12 @@ | |||
1 | with builtins; | ||
2 | |||
3 | [ (replaceStrings ["o"] ["a"] "foobar") | ||
4 | (replaceStrings ["o"] [""] "foobar") | ||
5 | (replaceStrings ["oo"] ["u"] "foobar") | ||
6 | (replaceStrings ["oo" "a"] ["a" "oo"] "foobar") | ||
7 | (replaceStrings ["oo" "oo"] ["u" "i"] "foobar") | ||
8 | (replaceStrings [""] ["X"] "abc") | ||
9 | (replaceStrings [""] ["X"] "") | ||
10 | (replaceStrings ["-"] ["_"] "a-b") | ||
11 | (replaceStrings ["oo" "XX"] ["u" (throw "unreachable")] "foobar") | ||
12 | ] | ||
diff --git a/test/testdata/eval-okay-scope-1.exp b/test/testdata/eval-okay-scope-1.exp new file mode 100644 index 0000000..00750ed --- /dev/null +++ b/test/testdata/eval-okay-scope-1.exp | |||
@@ -0,0 +1 @@ | |||
3 | |||
diff --git a/test/testdata/eval-okay-scope-1.nix b/test/testdata/eval-okay-scope-1.nix new file mode 100644 index 0000000..fa38a71 --- /dev/null +++ b/test/testdata/eval-okay-scope-1.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | (({x}: x: | ||
2 | |||
3 | { x = 1; | ||
4 | y = x; | ||
5 | } | ||
6 | ) {x = 2;} 3).y | ||
diff --git a/test/testdata/eval-okay-scope-2.exp b/test/testdata/eval-okay-scope-2.exp new file mode 100644 index 0000000..d00491f --- /dev/null +++ b/test/testdata/eval-okay-scope-2.exp | |||
@@ -0,0 +1 @@ | |||
1 | |||
diff --git a/test/testdata/eval-okay-scope-2.nix b/test/testdata/eval-okay-scope-2.nix new file mode 100644 index 0000000..eb8b02b --- /dev/null +++ b/test/testdata/eval-okay-scope-2.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | ((x: {x}: | ||
2 | rec { | ||
3 | x = 1; | ||
4 | y = x; | ||
5 | } | ||
6 | ) 2 {x = 3;}).y | ||
diff --git a/test/testdata/eval-okay-scope-3.exp b/test/testdata/eval-okay-scope-3.exp new file mode 100644 index 0000000..b8626c4 --- /dev/null +++ b/test/testdata/eval-okay-scope-3.exp | |||
@@ -0,0 +1 @@ | |||
4 | |||
diff --git a/test/testdata/eval-okay-scope-3.nix b/test/testdata/eval-okay-scope-3.nix new file mode 100644 index 0000000..10d6bc0 --- /dev/null +++ b/test/testdata/eval-okay-scope-3.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | ((x: as: {x}: | ||
2 | rec { | ||
3 | inherit (as) x; | ||
4 | y = x; | ||
5 | } | ||
6 | ) 2 {x = 4;} {x = 3;}).y | ||
diff --git a/test/testdata/eval-okay-scope-4.exp b/test/testdata/eval-okay-scope-4.exp new file mode 100644 index 0000000..00ff03a --- /dev/null +++ b/test/testdata/eval-okay-scope-4.exp | |||
@@ -0,0 +1 @@ | |||
"ccdd" | |||
diff --git a/test/testdata/eval-okay-scope-4.nix b/test/testdata/eval-okay-scope-4.nix new file mode 100644 index 0000000..dc8243b --- /dev/null +++ b/test/testdata/eval-okay-scope-4.nix | |||
@@ -0,0 +1,10 @@ | |||
1 | let { | ||
2 | |||
3 | x = "a"; | ||
4 | y = "b"; | ||
5 | |||
6 | f = {x ? y, y ? x}: x + y; | ||
7 | |||
8 | body = f {x = "c";} + f {y = "d";}; | ||
9 | |||
10 | } | ||
diff --git a/test/testdata/eval-okay-scope-6.exp b/test/testdata/eval-okay-scope-6.exp new file mode 100644 index 0000000..00ff03a --- /dev/null +++ b/test/testdata/eval-okay-scope-6.exp | |||
@@ -0,0 +1 @@ | |||
"ccdd" | |||
diff --git a/test/testdata/eval-okay-scope-6.nix b/test/testdata/eval-okay-scope-6.nix new file mode 100644 index 0000000..0995d4e --- /dev/null +++ b/test/testdata/eval-okay-scope-6.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | let { | ||
2 | |||
3 | f = {x ? y, y ? x}: x + y; | ||
4 | |||
5 | body = f {x = "c";} + f {y = "d";}; | ||
6 | |||
7 | } | ||
diff --git a/test/testdata/eval-okay-scope-7.exp b/test/testdata/eval-okay-scope-7.exp new file mode 100644 index 0000000..d00491f --- /dev/null +++ b/test/testdata/eval-okay-scope-7.exp | |||
@@ -0,0 +1 @@ | |||
1 | |||
diff --git a/test/testdata/eval-okay-scope-7.nix b/test/testdata/eval-okay-scope-7.nix new file mode 100644 index 0000000..4da0296 --- /dev/null +++ b/test/testdata/eval-okay-scope-7.nix | |||
@@ -0,0 +1,6 @@ | |||
1 | rec { | ||
2 | inherit (x) y; | ||
3 | x = { | ||
4 | y = 1; | ||
5 | }; | ||
6 | }.y | ||
diff --git a/test/testdata/eval-okay-search-path.exp b/test/testdata/eval-okay-search-path.exp new file mode 100644 index 0000000..4519bc4 --- /dev/null +++ b/test/testdata/eval-okay-search-path.exp | |||
@@ -0,0 +1 @@ | |||
"abccX" | |||
diff --git a/test/testdata/eval-okay-search-path.flags b/test/testdata/eval-okay-search-path.flags new file mode 100644 index 0000000..dfad1c6 --- /dev/null +++ b/test/testdata/eval-okay-search-path.flags | |||
@@ -0,0 +1 @@ | |||
-I lang/dir1 -I lang/dir2 -I dir5=lang/dir3 | |||
diff --git a/test/testdata/eval-okay-search-path.nix b/test/testdata/eval-okay-search-path.nix new file mode 100644 index 0000000..6fe33de --- /dev/null +++ b/test/testdata/eval-okay-search-path.nix | |||
@@ -0,0 +1,10 @@ | |||
1 | with import ./lib.nix; | ||
2 | with builtins; | ||
3 | |||
4 | assert isFunction (import <nix/fetchurl.nix>); | ||
5 | |||
6 | assert length __nixPath == 5; | ||
7 | assert length (filter (x: baseNameOf x.path == "dir4") __nixPath) == 1; | ||
8 | |||
9 | import <a.nix> + import <b.nix> + import <c.nix> + import <dir5/c.nix> | ||
10 | + (let __nixPath = [ { path = ./dir2; } { path = ./dir1; } ]; in import <a.nix>) | ||
diff --git a/test/testdata/eval-okay-seq.exp b/test/testdata/eval-okay-seq.exp new file mode 100644 index 0000000..0cfbf08 --- /dev/null +++ b/test/testdata/eval-okay-seq.exp | |||
@@ -0,0 +1 @@ | |||
2 | |||
diff --git a/test/testdata/eval-okay-seq.nix b/test/testdata/eval-okay-seq.nix new file mode 100644 index 0000000..0a9a21c --- /dev/null +++ b/test/testdata/eval-okay-seq.nix | |||
@@ -0,0 +1 @@ | |||
builtins.seq 1 2 | |||
diff --git a/test/testdata/eval-okay-sort.exp b/test/testdata/eval-okay-sort.exp new file mode 100644 index 0000000..899119e --- /dev/null +++ b/test/testdata/eval-okay-sort.exp | |||
@@ -0,0 +1 @@ | |||
[ [ 42 77 147 249 483 526 ] [ 526 483 249 147 77 42 ] [ "bar" "fnord" "foo" "xyzzy" ] [ { key = 1; value = "foo"; } { key = 1; value = "fnord"; } { key = 2; value = "bar"; } ] [ [ ] [ ] [ 1 ] [ 1 4 ] [ 1 5 ] [ 1 6 ] [ 2 ] [ 2 3 ] [ 3 ] [ 3 ] ] ] | |||
diff --git a/test/testdata/eval-okay-sort.nix b/test/testdata/eval-okay-sort.nix new file mode 100644 index 0000000..50aa78e --- /dev/null +++ b/test/testdata/eval-okay-sort.nix | |||
@@ -0,0 +1,20 @@ | |||
1 | with builtins; | ||
2 | |||
3 | [ (sort lessThan [ 483 249 526 147 42 77 ]) | ||
4 | (sort (x: y: y < x) [ 483 249 526 147 42 77 ]) | ||
5 | (sort lessThan [ "foo" "bar" "xyzzy" "fnord" ]) | ||
6 | (sort (x: y: x.key < y.key) | ||
7 | [ { key = 1; value = "foo"; } { key = 2; value = "bar"; } { key = 1; value = "fnord"; } ]) | ||
8 | (sort lessThan [ | ||
9 | [ 1 6 ] | ||
10 | [ ] | ||
11 | [ 2 3 ] | ||
12 | [ 3 ] | ||
13 | [ 1 5 ] | ||
14 | [ 2 ] | ||
15 | [ 1 ] | ||
16 | [ ] | ||
17 | [ 1 4 ] | ||
18 | [ 3 ] | ||
19 | ]) | ||
20 | ] | ||
diff --git a/test/testdata/eval-okay-splitversion.exp b/test/testdata/eval-okay-splitversion.exp new file mode 100644 index 0000000..153ceb8 --- /dev/null +++ b/test/testdata/eval-okay-splitversion.exp | |||
@@ -0,0 +1 @@ | |||
[ "1" "2" "3" ] | |||
diff --git a/test/testdata/eval-okay-splitversion.nix b/test/testdata/eval-okay-splitversion.nix new file mode 100644 index 0000000..9e5c99d --- /dev/null +++ b/test/testdata/eval-okay-splitversion.nix | |||
@@ -0,0 +1 @@ | |||
builtins.splitVersion "1.2.3" | |||
diff --git a/test/testdata/eval-okay-string.exp b/test/testdata/eval-okay-string.exp new file mode 100644 index 0000000..63f650f --- /dev/null +++ b/test/testdata/eval-okay-string.exp | |||
@@ -0,0 +1 @@ | |||
"foobar/a/b/c/d/foo/xyzzy/foo.txt/../foo/x/yescape: \"quote\" \n \\end\nof\nlinefoobarblaatfoo$bar$\"$\"$" | |||
diff --git a/test/testdata/eval-okay-string.nix b/test/testdata/eval-okay-string.nix new file mode 100644 index 0000000..47cc989 --- /dev/null +++ b/test/testdata/eval-okay-string.nix | |||
@@ -0,0 +1,12 @@ | |||
1 | "foo" + "bar" | ||
2 | + toString (/a/b + /c/d) | ||
3 | + toString (/foo/bar + "/../xyzzy/." + "/foo.txt") | ||
4 | + ("/../foo" + toString /x/y) | ||
5 | + "escape: \"quote\" \n \\" | ||
6 | + "end | ||
7 | of | ||
8 | line" | ||
9 | + "foo${if true then "b${"a" + "r"}" else "xyzzy"}blaat" | ||
10 | + "foo$bar" | ||
11 | + "$\"$\"" | ||
12 | + "$" | ||
diff --git a/test/testdata/eval-okay-strings-as-attrs-names.exp b/test/testdata/eval-okay-strings-as-attrs-names.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-strings-as-attrs-names.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-strings-as-attrs-names.nix b/test/testdata/eval-okay-strings-as-attrs-names.nix new file mode 100644 index 0000000..5e40928 --- /dev/null +++ b/test/testdata/eval-okay-strings-as-attrs-names.nix | |||
@@ -0,0 +1,20 @@ | |||
1 | let | ||
2 | |||
3 | attr = { | ||
4 | "key 1" = "test"; | ||
5 | "key 2" = "caseok"; | ||
6 | }; | ||
7 | |||
8 | t1 = builtins.getAttr "key 1" attr; | ||
9 | t2 = attr."key 2"; | ||
10 | t3 = attr ? "key 1"; | ||
11 | t4 = builtins.attrNames { inherit (attr) "key 1"; }; | ||
12 | |||
13 | # This is permitted, but there is currently no way to reference this | ||
14 | # variable. | ||
15 | "foo bar" = 1; | ||
16 | |||
17 | in t1 == "test" | ||
18 | && t2 == "caseok" | ||
19 | && t3 == true | ||
20 | && t4 == ["key 1"] | ||
diff --git a/test/testdata/eval-okay-substring-context.exp b/test/testdata/eval-okay-substring-context.exp new file mode 100644 index 0000000..2fe7f71 --- /dev/null +++ b/test/testdata/eval-okay-substring-context.exp | |||
@@ -0,0 +1 @@ | |||
"okay" | |||
diff --git a/test/testdata/eval-okay-substring-context.nix b/test/testdata/eval-okay-substring-context.nix new file mode 100644 index 0000000..d0ef70d --- /dev/null +++ b/test/testdata/eval-okay-substring-context.nix | |||
@@ -0,0 +1,11 @@ | |||
1 | with builtins; | ||
2 | |||
3 | let | ||
4 | |||
5 | s = "${builtins.derivation { name = "test"; builder = "/bin/sh"; system = "x86_64-linux"; }}"; | ||
6 | |||
7 | in | ||
8 | |||
9 | if getContext s == getContext "${substring 0 0 s + unsafeDiscardStringContext s}" | ||
10 | then "okay" | ||
11 | else throw "empty substring should preserve context" | ||
diff --git a/test/testdata/eval-okay-substring.exp b/test/testdata/eval-okay-substring.exp new file mode 100644 index 0000000..f48b462 --- /dev/null +++ b/test/testdata/eval-okay-substring.exp | |||
@@ -0,0 +1 @@ | |||
"ooxfoobarybarzobaabbc_bad" | |||
diff --git a/test/testdata/eval-okay-substring.nix b/test/testdata/eval-okay-substring.nix new file mode 100644 index 0000000..54c97e1 --- /dev/null +++ b/test/testdata/eval-okay-substring.nix | |||
@@ -0,0 +1,23 @@ | |||
1 | with builtins; | ||
2 | |||
3 | let | ||
4 | |||
5 | s = "foobar"; | ||
6 | |||
7 | in | ||
8 | |||
9 | substring 1 2 s | ||
10 | + "x" | ||
11 | + substring 0 (stringLength s) s | ||
12 | + "y" | ||
13 | + substring 3 100 s | ||
14 | + "z" | ||
15 | + substring 2 (sub (stringLength s) 3) s | ||
16 | + "a" | ||
17 | + substring 3 0 s | ||
18 | + "b" | ||
19 | + substring 3 1 s | ||
20 | + "c" | ||
21 | + substring 5 10 "perl" | ||
22 | + "_" | ||
23 | + substring 3 (-1) "tebbad" | ||
diff --git a/test/testdata/eval-okay-symlink-resolution.exp b/test/testdata/eval-okay-symlink-resolution.exp new file mode 100644 index 0000000..8b8441b --- /dev/null +++ b/test/testdata/eval-okay-symlink-resolution.exp | |||
@@ -0,0 +1 @@ | |||
"test" | |||
diff --git a/test/testdata/eval-okay-symlink-resolution.nix b/test/testdata/eval-okay-symlink-resolution.nix new file mode 100644 index 0000000..ffb1818 --- /dev/null +++ b/test/testdata/eval-okay-symlink-resolution.nix | |||
@@ -0,0 +1 @@ | |||
import symlink-resolution/foo/overlays/overlay.nix | |||
diff --git a/test/testdata/eval-okay-tail-call-1.exp-disabled b/test/testdata/eval-okay-tail-call-1.exp-disabled new file mode 100644 index 0000000..f7393e8 --- /dev/null +++ b/test/testdata/eval-okay-tail-call-1.exp-disabled | |||
@@ -0,0 +1 @@ | |||
100000 | |||
diff --git a/test/testdata/eval-okay-tail-call-1.nix b/test/testdata/eval-okay-tail-call-1.nix new file mode 100644 index 0000000..a3962ce --- /dev/null +++ b/test/testdata/eval-okay-tail-call-1.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | let | ||
2 | f = n: if n == 100000 then n else f (n + 1); | ||
3 | in f 0 | ||
diff --git a/test/testdata/eval-okay-tojson.exp b/test/testdata/eval-okay-tojson.exp new file mode 100644 index 0000000..e92aae3 --- /dev/null +++ b/test/testdata/eval-okay-tojson.exp | |||
@@ -0,0 +1 @@ | |||
"{\"a\":123,\"b\":-456,\"c\":\"foo\",\"d\":\"foo\\n\\\"bar\\\"\",\"e\":true,\"f\":false,\"g\":[1,2,3],\"h\":[\"a\",[\"b\",{\"foo\\nbar\":{}}]],\"i\":3,\"j\":1.44,\"k\":\"foo\"}" | |||
diff --git a/test/testdata/eval-okay-tojson.nix b/test/testdata/eval-okay-tojson.nix new file mode 100644 index 0000000..ce67943 --- /dev/null +++ b/test/testdata/eval-okay-tojson.nix | |||
@@ -0,0 +1,13 @@ | |||
1 | builtins.toJSON | ||
2 | { a = 123; | ||
3 | b = -456; | ||
4 | c = "foo"; | ||
5 | d = "foo\n\"bar\""; | ||
6 | e = true; | ||
7 | f = false; | ||
8 | g = [ 1 2 3 ]; | ||
9 | h = [ "a" [ "b" { "foo\nbar" = {}; } ] ]; | ||
10 | i = 1 + 2; | ||
11 | j = 1.44; | ||
12 | k = { __toString = self: self.a; a = "foo"; }; | ||
13 | } | ||
diff --git a/test/testdata/eval-okay-toxml.exp b/test/testdata/eval-okay-toxml.exp new file mode 100644 index 0000000..8282208 --- /dev/null +++ b/test/testdata/eval-okay-toxml.exp | |||
@@ -0,0 +1 @@ | |||
"<?xml version='1.0' encoding='utf-8'?>\n<expr>\n <attrs>\n <attr name=\"a\">\n <string value=\"s\" />\n </attr>\n </attrs>\n</expr>\n" | |||
diff --git a/test/testdata/eval-okay-toxml.nix b/test/testdata/eval-okay-toxml.nix new file mode 100644 index 0000000..068c97a --- /dev/null +++ b/test/testdata/eval-okay-toxml.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | # Make sure the expected XML output is produced; in particular, make sure it | ||
2 | # doesn't contain source location information. | ||
3 | builtins.toXML { a = "s"; } | ||
diff --git a/test/testdata/eval-okay-toxml2.exp b/test/testdata/eval-okay-toxml2.exp new file mode 100644 index 0000000..634a841 --- /dev/null +++ b/test/testdata/eval-okay-toxml2.exp | |||
@@ -0,0 +1 @@ | |||
"<?xml version='1.0' encoding='utf-8'?>\n<expr>\n <list>\n <string value=\"ab\" />\n <int value=\"10\" />\n <attrs>\n <attr name=\"x\">\n <string value=\"x\" />\n </attr>\n <attr name=\"y\">\n <string value=\"x\" />\n </attr>\n </attrs>\n </list>\n</expr>\n" | |||
diff --git a/test/testdata/eval-okay-toxml2.nix b/test/testdata/eval-okay-toxml2.nix new file mode 100644 index 0000000..ff1791b --- /dev/null +++ b/test/testdata/eval-okay-toxml2.nix | |||
@@ -0,0 +1 @@ | |||
builtins.toXML [("a" + "b") 10 (rec {x = "x"; y = x;})] | |||
diff --git a/test/testdata/eval-okay-tryeval.exp b/test/testdata/eval-okay-tryeval.exp new file mode 100644 index 0000000..2b2e6fa --- /dev/null +++ b/test/testdata/eval-okay-tryeval.exp | |||
@@ -0,0 +1 @@ | |||
{ x = { success = true; value = "x"; }; y = { success = false; value = false; }; z = { success = false; value = false; }; } | |||
diff --git a/test/testdata/eval-okay-tryeval.nix b/test/testdata/eval-okay-tryeval.nix new file mode 100644 index 0000000..629bc44 --- /dev/null +++ b/test/testdata/eval-okay-tryeval.nix | |||
@@ -0,0 +1,5 @@ | |||
1 | { | ||
2 | x = builtins.tryEval "x"; | ||
3 | y = builtins.tryEval (assert false; "y"); | ||
4 | z = builtins.tryEval (throw "bla"); | ||
5 | } | ||
diff --git a/test/testdata/eval-okay-types.exp b/test/testdata/eval-okay-types.exp new file mode 100644 index 0000000..92a1532 --- /dev/null +++ b/test/testdata/eval-okay-types.exp | |||
@@ -0,0 +1 @@ | |||
[ true false true false true false true false true true true true true true true true true true true false true true true false "int" "bool" "string" "null" "set" "list" "lambda" "lambda" "lambda" "lambda" ] | |||
diff --git a/test/testdata/eval-okay-types.nix b/test/testdata/eval-okay-types.nix new file mode 100644 index 0000000..9b58be5 --- /dev/null +++ b/test/testdata/eval-okay-types.nix | |||
@@ -0,0 +1,37 @@ | |||
1 | with builtins; | ||
2 | |||
3 | [ (isNull null) | ||
4 | (isNull (x: x)) | ||
5 | (isFunction (x: x)) | ||
6 | (isFunction "fnord") | ||
7 | (isString ("foo" + "bar")) | ||
8 | (isString [ "x" ]) | ||
9 | (isInt (1 + 2)) | ||
10 | (isInt { x = 123; }) | ||
11 | (isInt (1 / 2)) | ||
12 | (isInt (1 + 1)) | ||
13 | (isInt (1 / 2)) | ||
14 | (isInt (1 * 2)) | ||
15 | (isInt (1 - 2)) | ||
16 | (isFloat (1.2)) | ||
17 | (isFloat (1 + 1.0)) | ||
18 | (isFloat (1 / 2.0)) | ||
19 | (isFloat (1 * 2.0)) | ||
20 | (isFloat (1 - 2.0)) | ||
21 | (isBool (true && false)) | ||
22 | (isBool null) | ||
23 | (isPath /nix/store) | ||
24 | (isPath ./.) | ||
25 | (isAttrs { x = 123; }) | ||
26 | (isAttrs null) | ||
27 | (typeOf (3 * 4)) | ||
28 | (typeOf true) | ||
29 | (typeOf "xyzzy") | ||
30 | (typeOf null) | ||
31 | (typeOf { x = 456; }) | ||
32 | (typeOf [ 1 2 3 ]) | ||
33 | (typeOf (x: x)) | ||
34 | (typeOf ((x: y: x) 1)) | ||
35 | (typeOf map) | ||
36 | (typeOf (map (x: x))) | ||
37 | ] | ||
diff --git a/test/testdata/eval-okay-versions.exp b/test/testdata/eval-okay-versions.exp new file mode 100644 index 0000000..27ba77d --- /dev/null +++ b/test/testdata/eval-okay-versions.exp | |||
@@ -0,0 +1 @@ | |||
true | |||
diff --git a/test/testdata/eval-okay-versions.nix b/test/testdata/eval-okay-versions.nix new file mode 100644 index 0000000..e9111f5 --- /dev/null +++ b/test/testdata/eval-okay-versions.nix | |||
@@ -0,0 +1,43 @@ | |||
1 | let | ||
2 | |||
3 | name1 = "hello-1.0.2"; | ||
4 | name2 = "hello"; | ||
5 | name3 = "915resolution-0.5.2"; | ||
6 | name4 = "xf86-video-i810-1.7.4"; | ||
7 | name5 = "name-that-ends-with-dash--1.0"; | ||
8 | |||
9 | eq = 0; | ||
10 | lt = builtins.sub 0 1; | ||
11 | gt = 1; | ||
12 | |||
13 | versionTest = v1: v2: expected: | ||
14 | let d1 = builtins.compareVersions v1 v2; | ||
15 | d2 = builtins.compareVersions v2 v1; | ||
16 | in d1 == builtins.sub 0 d2 && d1 == expected; | ||
17 | |||
18 | tests = [ | ||
19 | ((builtins.parseDrvName name1).name == "hello") | ||
20 | ((builtins.parseDrvName name1).version == "1.0.2") | ||
21 | ((builtins.parseDrvName name2).name == "hello") | ||
22 | ((builtins.parseDrvName name2).version == "") | ||
23 | ((builtins.parseDrvName name3).name == "915resolution") | ||
24 | ((builtins.parseDrvName name3).version == "0.5.2") | ||
25 | ((builtins.parseDrvName name4).name == "xf86-video-i810") | ||
26 | ((builtins.parseDrvName name4).version == "1.7.4") | ||
27 | ((builtins.parseDrvName name5).name == "name-that-ends-with-dash") | ||
28 | ((builtins.parseDrvName name5).version == "-1.0") | ||
29 | (versionTest "1.0" "2.3" lt) | ||
30 | (versionTest "2.1" "2.3" lt) | ||
31 | (versionTest "2.3" "2.3" eq) | ||
32 | (versionTest "2.5" "2.3" gt) | ||
33 | (versionTest "3.1" "2.3" gt) | ||
34 | (versionTest "2.3.1" "2.3" gt) | ||
35 | (versionTest "2.3.1" "2.3a" gt) | ||
36 | (versionTest "2.3pre1" "2.3" lt) | ||
37 | (versionTest "2.3pre3" "2.3pre12" lt) | ||
38 | (versionTest "2.3a" "2.3c" lt) | ||
39 | (versionTest "2.3pre1" "2.3c" lt) | ||
40 | (versionTest "2.3pre1" "2.3q" lt) | ||
41 | ]; | ||
42 | |||
43 | in (import ./lib.nix).and tests | ||
diff --git a/test/testdata/eval-okay-with.exp b/test/testdata/eval-okay-with.exp new file mode 100644 index 0000000..378c8dc --- /dev/null +++ b/test/testdata/eval-okay-with.exp | |||
@@ -0,0 +1 @@ | |||
"xyzzybarxyzzybar" | |||
diff --git a/test/testdata/eval-okay-with.nix b/test/testdata/eval-okay-with.nix new file mode 100644 index 0000000..033e8d3 --- /dev/null +++ b/test/testdata/eval-okay-with.nix | |||
@@ -0,0 +1,19 @@ | |||
1 | let { | ||
2 | |||
3 | a = "xyzzy"; | ||
4 | |||
5 | as = { | ||
6 | a = "foo"; | ||
7 | b = "bar"; | ||
8 | }; | ||
9 | |||
10 | bs = { | ||
11 | a = "bar"; | ||
12 | }; | ||
13 | |||
14 | x = with as; a + b; | ||
15 | |||
16 | y = with as; with bs; a + b; | ||
17 | |||
18 | body = x + y; | ||
19 | } | ||
diff --git a/test/testdata/eval-okay-xml.exp.xml b/test/testdata/eval-okay-xml.exp.xml new file mode 100644 index 0000000..2009932 --- /dev/null +++ b/test/testdata/eval-okay-xml.exp.xml | |||
@@ -0,0 +1,52 @@ | |||
1 | <?xml version='1.0' encoding='utf-8'?> | ||
2 | <expr> | ||
3 | <attrs> | ||
4 | <attr name="a"> | ||
5 | <string value="foo" /> | ||
6 | </attr> | ||
7 | <attr name="at"> | ||
8 | <function> | ||
9 | <attrspat name="args"> | ||
10 | <attr name="x" /> | ||
11 | <attr name="y" /> | ||
12 | <attr name="z" /> | ||
13 | </attrspat> | ||
14 | </function> | ||
15 | </attr> | ||
16 | <attr name="b"> | ||
17 | <string value="bar" /> | ||
18 | </attr> | ||
19 | <attr name="c"> | ||
20 | <string value="foobar" /> | ||
21 | </attr> | ||
22 | <attr name="ellipsis"> | ||
23 | <function> | ||
24 | <attrspat ellipsis="1"> | ||
25 | <attr name="x" /> | ||
26 | <attr name="y" /> | ||
27 | <attr name="z" /> | ||
28 | </attrspat> | ||
29 | </function> | ||
30 | </attr> | ||
31 | <attr name="f"> | ||
32 | <function> | ||
33 | <attrspat> | ||
34 | <attr name="x" /> | ||
35 | <attr name="y" /> | ||
36 | <attr name="z" /> | ||
37 | </attrspat> | ||
38 | </function> | ||
39 | </attr> | ||
40 | <attr name="id"> | ||
41 | <function> | ||
42 | <varpat name="x" /> | ||
43 | </function> | ||
44 | </attr> | ||
45 | <attr name="x"> | ||
46 | <int value="123" /> | ||
47 | </attr> | ||
48 | <attr name="y"> | ||
49 | <float value="567.89" /> | ||
50 | </attr> | ||
51 | </attrs> | ||
52 | </expr> | ||
diff --git a/test/testdata/eval-okay-xml.nix b/test/testdata/eval-okay-xml.nix new file mode 100644 index 0000000..9ee9f8a --- /dev/null +++ b/test/testdata/eval-okay-xml.nix | |||
@@ -0,0 +1,21 @@ | |||
1 | rec { | ||
2 | |||
3 | x = 123; | ||
4 | |||
5 | y = 567.890; | ||
6 | |||
7 | a = "foo"; | ||
8 | |||
9 | b = "bar"; | ||
10 | |||
11 | c = "foo" + "bar"; | ||
12 | |||
13 | f = {z, x, y}: if y then x else z; | ||
14 | |||
15 | id = x: x; | ||
16 | |||
17 | at = args@{x, y, z}: x; | ||
18 | |||
19 | ellipsis = {x, y, z, ...}: x; | ||
20 | |||
21 | } | ||
diff --git a/test/testdata/eval-okay-zipAttrsWith.exp b/test/testdata/eval-okay-zipAttrsWith.exp new file mode 100644 index 0000000..9c0b15d --- /dev/null +++ b/test/testdata/eval-okay-zipAttrsWith.exp | |||
@@ -0,0 +1 @@ | |||
{ "0" = { n = "0"; v = [ 5 23 29 ]; }; "1" = { n = "1"; v = [ 7 30 ]; }; "2" = { n = "2"; v = [ 18 ]; }; "4" = { n = "4"; v = [ 10 ]; }; "5" = { n = "5"; v = [ 15 25 26 31 ]; }; "6" = { n = "6"; v = [ 3 14 ]; }; "7" = { n = "7"; v = [ 12 ]; }; "8" = { n = "8"; v = [ 2 6 8 9 ]; }; "9" = { n = "9"; v = [ 0 16 ]; }; a = { n = "a"; v = [ 17 21 22 27 ]; }; c = { n = "c"; v = [ 11 24 ]; }; d = { n = "d"; v = [ 4 13 28 ]; }; e = { n = "e"; v = [ 20 ]; }; f = { n = "f"; v = [ 1 19 ]; }; } | |||
diff --git a/test/testdata/eval-okay-zipAttrsWith.nix b/test/testdata/eval-okay-zipAttrsWith.nix new file mode 100644 index 0000000..877d4e5 --- /dev/null +++ b/test/testdata/eval-okay-zipAttrsWith.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | with import ./lib.nix; | ||
2 | |||
3 | let | ||
4 | str = builtins.hashString "sha256" "test"; | ||
5 | in | ||
6 | builtins.zipAttrsWith | ||
7 | (n: v: { inherit n v; }) | ||
8 | (map (n: { ${builtins.substring n 1 str} = n; }) | ||
9 | (range 0 31)) | ||
diff --git a/test/testdata/importdef.sexp b/test/testdata/importdef.sexp new file mode 100644 index 0000000..bf8debb --- /dev/null +++ b/test/testdata/importdef.sexp | |||
@@ -0,0 +1 @@ | |||
(deps ./lib.nix) | |||
diff --git a/test/testdata/imported.nix b/test/testdata/imported.nix new file mode 100644 index 0000000..fb39ee4 --- /dev/null +++ b/test/testdata/imported.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | # The function ‘range’ comes from lib.nix and was added to the lexical | ||
2 | # scope by scopedImport. | ||
3 | range 1 5 ++ import ./imported2.nix | ||
diff --git a/test/testdata/imported2.nix b/test/testdata/imported2.nix new file mode 100644 index 0000000..6d0a299 --- /dev/null +++ b/test/testdata/imported2.nix | |||
@@ -0,0 +1 @@ | |||
range 6 10 | |||
diff --git a/test/testdata/lib.nix b/test/testdata/lib.nix new file mode 100644 index 0000000..028a538 --- /dev/null +++ b/test/testdata/lib.nix | |||
@@ -0,0 +1,61 @@ | |||
1 | with builtins; | ||
2 | |||
3 | rec { | ||
4 | |||
5 | fold = op: nul: list: | ||
6 | if list == [] | ||
7 | then nul | ||
8 | else op (head list) (fold op nul (tail list)); | ||
9 | |||
10 | concat = | ||
11 | fold (x: y: x + y) ""; | ||
12 | |||
13 | and = fold (x: y: x && y) true; | ||
14 | |||
15 | flatten = x: | ||
16 | if isList x | ||
17 | then fold (x: y: (flatten x) ++ y) [] x | ||
18 | else [x]; | ||
19 | |||
20 | sum = foldl' (x: y: add x y) 0; | ||
21 | |||
22 | hasSuffix = ext: fileName: | ||
23 | let lenFileName = stringLength fileName; | ||
24 | lenExt = stringLength ext; | ||
25 | in !(lessThan lenFileName lenExt) && | ||
26 | substring (sub lenFileName lenExt) lenFileName fileName == ext; | ||
27 | |||
28 | # Split a list at the given position. | ||
29 | splitAt = pos: list: | ||
30 | if pos == 0 then {first = []; second = list;} else | ||
31 | if list == [] then {first = []; second = [];} else | ||
32 | let res = splitAt (sub pos 1) (tail list); | ||
33 | in {first = [(head list)] ++ res.first; second = res.second;}; | ||
34 | |||
35 | # Stable merge sort. | ||
36 | sortBy = comp: list: | ||
37 | if lessThan 1 (length list) | ||
38 | then | ||
39 | let | ||
40 | split = splitAt (div (length list) 2) list; | ||
41 | first = sortBy comp split.first; | ||
42 | second = sortBy comp split.second; | ||
43 | in mergeLists comp first second | ||
44 | else list; | ||
45 | |||
46 | mergeLists = comp: list1: list2: | ||
47 | if list1 == [] then list2 else | ||
48 | if list2 == [] then list1 else | ||
49 | if comp (head list2) (head list1) then [(head list2)] ++ mergeLists comp list1 (tail list2) else | ||
50 | [(head list1)] ++ mergeLists comp (tail list1) list2; | ||
51 | |||
52 | id = x: x; | ||
53 | |||
54 | const = x: y: x; | ||
55 | |||
56 | range = first: last: | ||
57 | if first > last | ||
58 | then [] | ||
59 | else genList (n: first + n) (last - first + 1); | ||
60 | |||
61 | } | ||
diff --git a/test/testdata/non-eval-fail-bad-drvPath.nix b/test/testdata/non-eval-fail-bad-drvPath.nix new file mode 100644 index 0000000..23639bc --- /dev/null +++ b/test/testdata/non-eval-fail-bad-drvPath.nix | |||
@@ -0,0 +1,14 @@ | |||
1 | let | ||
2 | package = { | ||
3 | type = "derivation"; | ||
4 | name = "cachix-1.7.3"; | ||
5 | system = builtins.currentSystem; | ||
6 | outputs = [ "out" ]; | ||
7 | # Illegal, because does not end in `.drv` | ||
8 | drvPath = "${builtins.storeDir}/8qlfcic10lw5304gqm8q45nr7g7jl62b-cachix-1.7.3-bin"; | ||
9 | outputName = "out"; | ||
10 | outPath = "${builtins.storeDir}/8qlfcic10lw5304gqm8q45nr7g7jl62b-cachix-1.7.3-bin"; | ||
11 | out = package; | ||
12 | }; | ||
13 | in | ||
14 | package | ||
diff --git a/test/testdata/parse-fail-dup-attrs-1.err.exp b/test/testdata/parse-fail-dup-attrs-1.err.exp new file mode 100644 index 0000000..ffb5198 --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-1.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: attribute 'x' already defined at «stdin»:1:3 | ||
2 | at «stdin»:3:3: | ||
3 | 2| y = 456; | ||
4 | 3| x = 789; | ||
5 | | ^ | ||
6 | 4| } | ||
diff --git a/test/testdata/parse-fail-dup-attrs-1.nix b/test/testdata/parse-fail-dup-attrs-1.nix new file mode 100644 index 0000000..2c02317 --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-1.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | { x = 123; | ||
2 | y = 456; | ||
3 | x = 789; | ||
4 | } | ||
diff --git a/test/testdata/parse-fail-dup-attrs-2.err.exp b/test/testdata/parse-fail-dup-attrs-2.err.exp new file mode 100644 index 0000000..3105e60 --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-2.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: attribute 'x' already defined at «stdin»:9:5 | ||
2 | at «stdin»:10:18: | ||
3 | 9| x = 789; | ||
4 | 10| inherit (as) x; | ||
5 | | ^ | ||
6 | 11| }; | ||
diff --git a/test/testdata/parse-fail-dup-attrs-2.nix b/test/testdata/parse-fail-dup-attrs-2.nix new file mode 100644 index 0000000..864d986 --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-2.nix | |||
@@ -0,0 +1,13 @@ | |||
1 | let { | ||
2 | |||
3 | as = { | ||
4 | x = 123; | ||
5 | y = 456; | ||
6 | }; | ||
7 | |||
8 | bs = { | ||
9 | x = 789; | ||
10 | inherit (as) x; | ||
11 | }; | ||
12 | |||
13 | } | ||
diff --git a/test/testdata/parse-fail-dup-attrs-3.err.exp b/test/testdata/parse-fail-dup-attrs-3.err.exp new file mode 100644 index 0000000..3105e60 --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-3.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: attribute 'x' already defined at «stdin»:9:5 | ||
2 | at «stdin»:10:18: | ||
3 | 9| x = 789; | ||
4 | 10| inherit (as) x; | ||
5 | | ^ | ||
6 | 11| }; | ||
diff --git a/test/testdata/parse-fail-dup-attrs-3.nix b/test/testdata/parse-fail-dup-attrs-3.nix new file mode 100644 index 0000000..114d197 --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-3.nix | |||
@@ -0,0 +1,13 @@ | |||
1 | let { | ||
2 | |||
3 | as = { | ||
4 | x = 123; | ||
5 | y = 456; | ||
6 | }; | ||
7 | |||
8 | bs = rec { | ||
9 | x = 789; | ||
10 | inherit (as) x; | ||
11 | }; | ||
12 | |||
13 | } | ||
diff --git a/test/testdata/parse-fail-dup-attrs-4.err.exp b/test/testdata/parse-fail-dup-attrs-4.err.exp new file mode 100644 index 0000000..c98a8f8 --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-4.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: attribute 'services.ssh.port' already defined at «stdin»:2:3 | ||
2 | at «stdin»:3:3: | ||
3 | 2| services.ssh.port = 22; | ||
4 | 3| services.ssh.port = 23; | ||
5 | | ^ | ||
6 | 4| } | ||
diff --git a/test/testdata/parse-fail-dup-attrs-4.nix b/test/testdata/parse-fail-dup-attrs-4.nix new file mode 100644 index 0000000..7741743 --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-4.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | { | ||
2 | services.ssh.port = 22; | ||
3 | services.ssh.port = 23; | ||
4 | } | ||
diff --git a/test/testdata/parse-fail-dup-attrs-7.err.exp b/test/testdata/parse-fail-dup-attrs-7.err.exp new file mode 100644 index 0000000..4e0a48e --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-7.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: attribute 'x' already defined at «stdin»:6:13 | ||
2 | at «stdin»:7:13: | ||
3 | 6| inherit x; | ||
4 | 7| inherit x; | ||
5 | | ^ | ||
6 | 8| }; | ||
diff --git a/test/testdata/parse-fail-dup-attrs-7.nix b/test/testdata/parse-fail-dup-attrs-7.nix new file mode 100644 index 0000000..bbc3eb0 --- /dev/null +++ b/test/testdata/parse-fail-dup-attrs-7.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | rec { | ||
2 | |||
3 | x = 1; | ||
4 | |||
5 | as = { | ||
6 | inherit x; | ||
7 | inherit x; | ||
8 | }; | ||
9 | } \ No newline at end of file | ||
diff --git a/test/testdata/parse-fail-dup-formals.err.exp b/test/testdata/parse-fail-dup-formals.err.exp new file mode 100644 index 0000000..d7c7e02 --- /dev/null +++ b/test/testdata/parse-fail-dup-formals.err.exp | |||
@@ -0,0 +1,4 @@ | |||
1 | error: duplicate formal function argument 'x' | ||
2 | at «stdin»:1:8: | ||
3 | 1| {x, y, x}: x | ||
4 | | ^ | ||
diff --git a/test/testdata/parse-fail-dup-formals.nix b/test/testdata/parse-fail-dup-formals.nix new file mode 100644 index 0000000..a0edd91 --- /dev/null +++ b/test/testdata/parse-fail-dup-formals.nix | |||
@@ -0,0 +1 @@ | |||
{x, y, x}: x \ No newline at end of file | |||
diff --git a/test/testdata/parse-fail-eof-in-string.err.exp b/test/testdata/parse-fail-eof-in-string.err.exp new file mode 100644 index 0000000..17f34b6 --- /dev/null +++ b/test/testdata/parse-fail-eof-in-string.err.exp | |||
@@ -0,0 +1,5 @@ | |||
1 | error: syntax error, unexpected end of file, expecting '"' | ||
2 | at «stdin»:3:6: | ||
3 | 2| # Note that this file must not end with a newline. | ||
4 | 3| a 1"$ | ||
5 | | ^ | ||
diff --git a/test/testdata/parse-fail-eof-in-string.nix b/test/testdata/parse-fail-eof-in-string.nix new file mode 100644 index 0000000..19775d2 --- /dev/null +++ b/test/testdata/parse-fail-eof-in-string.nix | |||
@@ -0,0 +1,3 @@ | |||
1 | # https://github.com/NixOS/nix/issues/6562 | ||
2 | # Note that this file must not end with a newline. | ||
3 | a 1"$ \ No newline at end of file | ||
diff --git a/test/testdata/parse-fail-eof-pos.err.exp b/test/testdata/parse-fail-eof-pos.err.exp new file mode 100644 index 0000000..ef9ca38 --- /dev/null +++ b/test/testdata/parse-fail-eof-pos.err.exp | |||
@@ -0,0 +1,5 @@ | |||
1 | error: syntax error, unexpected end of file | ||
2 | at «stdin»:3:1: | ||
3 | 2| # no content | ||
4 | 3| | ||
5 | | ^ | ||
diff --git a/test/testdata/parse-fail-eof-pos.nix b/test/testdata/parse-fail-eof-pos.nix new file mode 100644 index 0000000..bd66a2c --- /dev/null +++ b/test/testdata/parse-fail-eof-pos.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | ( | ||
2 | # no content | ||
diff --git a/test/testdata/parse-fail-mixed-nested-attrs1.err.exp b/test/testdata/parse-fail-mixed-nested-attrs1.err.exp new file mode 100644 index 0000000..a447215 --- /dev/null +++ b/test/testdata/parse-fail-mixed-nested-attrs1.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: attribute 'z' already defined at «stdin»:3:16 | ||
2 | at «stdin»:2:3: | ||
3 | 1| { | ||
4 | 2| x.z = 3; | ||
5 | | ^ | ||
6 | 3| x = { y = 3; z = 3; }; | ||
diff --git a/test/testdata/parse-fail-mixed-nested-attrs1.nix b/test/testdata/parse-fail-mixed-nested-attrs1.nix new file mode 100644 index 0000000..11e40e6 --- /dev/null +++ b/test/testdata/parse-fail-mixed-nested-attrs1.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | { | ||
2 | x.z = 3; | ||
3 | x = { y = 3; z = 3; }; | ||
4 | } | ||
diff --git a/test/testdata/parse-fail-mixed-nested-attrs2.err.exp b/test/testdata/parse-fail-mixed-nested-attrs2.err.exp new file mode 100644 index 0000000..ead1f0d --- /dev/null +++ b/test/testdata/parse-fail-mixed-nested-attrs2.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: attribute 'y' already defined at «stdin»:3:9 | ||
2 | at «stdin»:2:3: | ||
3 | 1| { | ||
4 | 2| x.y.y = 3; | ||
5 | | ^ | ||
6 | 3| x = { y.y= 3; z = 3; }; | ||
diff --git a/test/testdata/parse-fail-mixed-nested-attrs2.nix b/test/testdata/parse-fail-mixed-nested-attrs2.nix new file mode 100644 index 0000000..17da82e --- /dev/null +++ b/test/testdata/parse-fail-mixed-nested-attrs2.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | { | ||
2 | x.y.y = 3; | ||
3 | x = { y.y= 3; z = 3; }; | ||
4 | } | ||
diff --git a/test/testdata/parse-fail-patterns-1.err.exp b/test/testdata/parse-fail-patterns-1.err.exp new file mode 100644 index 0000000..6ba39d8 --- /dev/null +++ b/test/testdata/parse-fail-patterns-1.err.exp | |||
@@ -0,0 +1,5 @@ | |||
1 | error: duplicate formal function argument 'args' | ||
2 | at «stdin»:1:1: | ||
3 | 1| args@{args, x, y, z}: x | ||
4 | | ^ | ||
5 | 2| | ||
diff --git a/test/testdata/parse-fail-patterns-1.nix b/test/testdata/parse-fail-patterns-1.nix new file mode 100644 index 0000000..7b40616 --- /dev/null +++ b/test/testdata/parse-fail-patterns-1.nix | |||
@@ -0,0 +1 @@ | |||
args@{args, x, y, z}: x | |||
diff --git a/test/testdata/parse-fail-regression-20060610.err.exp b/test/testdata/parse-fail-regression-20060610.err.exp new file mode 100644 index 0000000..6ae7c01 --- /dev/null +++ b/test/testdata/parse-fail-regression-20060610.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: undefined variable 'gcc' | ||
2 | at «stdin»:9:13: | ||
3 | 8| body = ({ | ||
4 | 9| inherit gcc; | ||
5 | | ^ | ||
6 | 10| }).gcc; | ||
diff --git a/test/testdata/parse-fail-regression-20060610.nix b/test/testdata/parse-fail-regression-20060610.nix new file mode 100644 index 0000000..b1934f7 --- /dev/null +++ b/test/testdata/parse-fail-regression-20060610.nix | |||
@@ -0,0 +1,11 @@ | |||
1 | let { | ||
2 | x = | ||
3 | {gcc}: | ||
4 | { | ||
5 | inherit gcc; | ||
6 | }; | ||
7 | |||
8 | body = ({ | ||
9 | inherit gcc; | ||
10 | }).gcc; | ||
11 | } | ||
diff --git a/test/testdata/parse-fail-undef-var-2.err.exp b/test/testdata/parse-fail-undef-var-2.err.exp new file mode 100644 index 0000000..96e87b2 --- /dev/null +++ b/test/testdata/parse-fail-undef-var-2.err.exp | |||
@@ -0,0 +1,6 @@ | |||
1 | error: syntax error, unexpected ':', expecting '}' or ',' | ||
2 | at «stdin»:3:13: | ||
3 | 2| | ||
4 | 3| f = {x, y : ["baz" "bar" z "bat"]}: x + y; | ||
5 | | ^ | ||
6 | 4| | ||
diff --git a/test/testdata/parse-fail-undef-var-2.nix b/test/testdata/parse-fail-undef-var-2.nix new file mode 100644 index 0000000..c10a52b --- /dev/null +++ b/test/testdata/parse-fail-undef-var-2.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | let { | ||
2 | |||
3 | f = {x, y : ["baz" "bar" z "bat"]}: x + y; | ||
4 | |||
5 | body = f {x = "foo"; y = "bar";}; | ||
6 | |||
7 | } | ||
diff --git a/test/testdata/parse-fail-undef-var.err.exp b/test/testdata/parse-fail-undef-var.err.exp new file mode 100644 index 0000000..3d143d9 --- /dev/null +++ b/test/testdata/parse-fail-undef-var.err.exp | |||
@@ -0,0 +1,5 @@ | |||
1 | error: undefined variable 'y' | ||
2 | at «stdin»:1:4: | ||
3 | 1| x: y | ||
4 | | ^ | ||
5 | 2| | ||
diff --git a/test/testdata/parse-fail-undef-var.nix b/test/testdata/parse-fail-undef-var.nix new file mode 100644 index 0000000..7b63008 --- /dev/null +++ b/test/testdata/parse-fail-undef-var.nix | |||
@@ -0,0 +1 @@ | |||
x: y | |||
diff --git a/test/testdata/parse-fail-utf8.err.exp b/test/testdata/parse-fail-utf8.err.exp new file mode 100644 index 0000000..1c83f6e --- /dev/null +++ b/test/testdata/parse-fail-utf8.err.exp | |||
@@ -0,0 +1,5 @@ | |||
1 | error: syntax error, unexpected invalid token, expecting end of file | ||
2 | at «stdin»:1:5: | ||
3 | 1| 123 é 4 | ||
4 | | ^ | ||
5 | 2| | ||
diff --git a/test/testdata/parse-fail-utf8.nix b/test/testdata/parse-fail-utf8.nix new file mode 100644 index 0000000..34948d4 --- /dev/null +++ b/test/testdata/parse-fail-utf8.nix | |||
@@ -0,0 +1 @@ | |||
123 é 4 | |||
diff --git a/test/testdata/parse-okay-1.exp b/test/testdata/parse-okay-1.exp new file mode 100644 index 0000000..d5ab5f1 --- /dev/null +++ b/test/testdata/parse-okay-1.exp | |||
@@ -0,0 +1 @@ | |||
({ x, y, z }: ((x + y) + z)) | |||
diff --git a/test/testdata/parse-okay-1.nix b/test/testdata/parse-okay-1.nix new file mode 100644 index 0000000..23a58ed --- /dev/null +++ b/test/testdata/parse-okay-1.nix | |||
@@ -0,0 +1 @@ | |||
{x, y, z}: x + y + z | |||
diff --git a/test/testdata/parse-okay-crlf.exp b/test/testdata/parse-okay-crlf.exp new file mode 100644 index 0000000..4213609 --- /dev/null +++ b/test/testdata/parse-okay-crlf.exp | |||
@@ -0,0 +1 @@ | |||
rec { foo = "multi\nline\n string\n test\r"; x = y; y = 123; z = 456; } | |||
diff --git a/test/testdata/parse-okay-crlf.nix b/test/testdata/parse-okay-crlf.nix new file mode 100644 index 0000000..21518d4 --- /dev/null +++ b/test/testdata/parse-okay-crlf.nix | |||
@@ -0,0 +1,17 @@ | |||
1 | rec { | ||
2 | |||
3 | /* Dit is | ||
4 | een test. */ | ||
5 | |||
6 | x = | ||
7 | # Dit is een test. y; | ||
8 | |||
9 | y = 123; | ||
10 | |||
11 | # CR or CR/LF (but not explicit \r's) in strings should be | ||
12 | # translated to LF. | ||
13 | foo = "multi line | ||
14 | string | ||
15 | test\r"; | ||
16 | |||
17 | z = 456; } | ||
diff --git a/test/testdata/parse-okay-dup-attrs-5.exp b/test/testdata/parse-okay-dup-attrs-5.exp new file mode 100644 index 0000000..88b0b03 --- /dev/null +++ b/test/testdata/parse-okay-dup-attrs-5.exp | |||
@@ -0,0 +1 @@ | |||
{ services = { ssh = { enable = true; port = 23; }; }; } | |||
diff --git a/test/testdata/parse-okay-dup-attrs-5.nix b/test/testdata/parse-okay-dup-attrs-5.nix new file mode 100644 index 0000000..f4b9efd --- /dev/null +++ b/test/testdata/parse-okay-dup-attrs-5.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | { | ||
2 | services.ssh = { enable = true; }; | ||
3 | services.ssh.port = 23; | ||
4 | } | ||
diff --git a/test/testdata/parse-okay-dup-attrs-6.exp b/test/testdata/parse-okay-dup-attrs-6.exp new file mode 100644 index 0000000..88b0b03 --- /dev/null +++ b/test/testdata/parse-okay-dup-attrs-6.exp | |||
@@ -0,0 +1 @@ | |||
{ services = { ssh = { enable = true; port = 23; }; }; } | |||
diff --git a/test/testdata/parse-okay-dup-attrs-6.nix b/test/testdata/parse-okay-dup-attrs-6.nix new file mode 100644 index 0000000..ae6d7a7 --- /dev/null +++ b/test/testdata/parse-okay-dup-attrs-6.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | { | ||
2 | services.ssh.port = 23; | ||
3 | services.ssh = { enable = true; }; | ||
4 | } | ||
diff --git a/test/testdata/parse-okay-ind-string.exp b/test/testdata/parse-okay-ind-string.exp new file mode 100644 index 0000000..82e9940 --- /dev/null +++ b/test/testdata/parse-okay-ind-string.exp | |||
@@ -0,0 +1 @@ | |||
(let string = "str"; in [ (/some/path) ((/some/path)) ((/some/path)) ((/some/path + "\n end")) (string) ((string)) ((string)) ((string + "\n end")) ("") ("") ("end") ]) | |||
diff --git a/test/testdata/parse-okay-ind-string.nix b/test/testdata/parse-okay-ind-string.nix new file mode 100644 index 0000000..97c9de3 --- /dev/null +++ b/test/testdata/parse-okay-ind-string.nix | |||
@@ -0,0 +1,31 @@ | |||
1 | let | ||
2 | string = "str"; | ||
3 | in [ | ||
4 | /some/path | ||
5 | |||
6 | ''${/some/path}'' | ||
7 | |||
8 | '' | ||
9 | ${/some/path}'' | ||
10 | |||
11 | ''${/some/path} | ||
12 | end'' | ||
13 | |||
14 | string | ||
15 | |||
16 | ''${string}'' | ||
17 | |||
18 | '' | ||
19 | ${string}'' | ||
20 | |||
21 | ''${string} | ||
22 | end'' | ||
23 | |||
24 | '''' | ||
25 | |||
26 | '' | ||
27 | '' | ||
28 | |||
29 | '' | ||
30 | end'' | ||
31 | ] | ||
diff --git a/test/testdata/parse-okay-inherits.exp b/test/testdata/parse-okay-inherits.exp new file mode 100644 index 0000000..1355527 --- /dev/null +++ b/test/testdata/parse-okay-inherits.exp | |||
@@ -0,0 +1 @@ | |||
(let b = 2; c = { }; in { inherit b; inherit (c) d e; a = 1; f = 3; }) | |||
diff --git a/test/testdata/parse-okay-inherits.nix b/test/testdata/parse-okay-inherits.nix new file mode 100644 index 0000000..10596c8 --- /dev/null +++ b/test/testdata/parse-okay-inherits.nix | |||
@@ -0,0 +1,9 @@ | |||
1 | let | ||
2 | c = {}; | ||
3 | b = 2; | ||
4 | in { | ||
5 | a = 1; | ||
6 | inherit b; | ||
7 | inherit (c) d e; | ||
8 | f = 3; | ||
9 | } | ||
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-1.exp b/test/testdata/parse-okay-mixed-nested-attrs-1.exp new file mode 100644 index 0000000..89c66f7 --- /dev/null +++ b/test/testdata/parse-okay-mixed-nested-attrs-1.exp | |||
@@ -0,0 +1 @@ | |||
{ x = { q = 3; y = 3; z = 3; }; } | |||
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-1.nix b/test/testdata/parse-okay-mixed-nested-attrs-1.nix new file mode 100644 index 0000000..fd1001c --- /dev/null +++ b/test/testdata/parse-okay-mixed-nested-attrs-1.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | { | ||
2 | x = { y = 3; z = 3; }; | ||
3 | x.q = 3; | ||
4 | } | ||
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-2.exp b/test/testdata/parse-okay-mixed-nested-attrs-2.exp new file mode 100644 index 0000000..89c66f7 --- /dev/null +++ b/test/testdata/parse-okay-mixed-nested-attrs-2.exp | |||
@@ -0,0 +1 @@ | |||
{ x = { q = 3; y = 3; z = 3; }; } | |||
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-2.nix b/test/testdata/parse-okay-mixed-nested-attrs-2.nix new file mode 100644 index 0000000..ad066b6 --- /dev/null +++ b/test/testdata/parse-okay-mixed-nested-attrs-2.nix | |||
@@ -0,0 +1,4 @@ | |||
1 | { | ||
2 | x.q = 3; | ||
3 | x = { y = 3; z = 3; }; | ||
4 | } | ||
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-3.exp b/test/testdata/parse-okay-mixed-nested-attrs-3.exp new file mode 100644 index 0000000..b89a597 --- /dev/null +++ b/test/testdata/parse-okay-mixed-nested-attrs-3.exp | |||
@@ -0,0 +1 @@ | |||
{ services = { httpd = { enable = true; }; ssh = { enable = true; port = 123; }; }; } | |||
diff --git a/test/testdata/parse-okay-mixed-nested-attrs-3.nix b/test/testdata/parse-okay-mixed-nested-attrs-3.nix new file mode 100644 index 0000000..45a33e4 --- /dev/null +++ b/test/testdata/parse-okay-mixed-nested-attrs-3.nix | |||
@@ -0,0 +1,7 @@ | |||
1 | { | ||
2 | services.ssh.enable = true; | ||
3 | services.ssh = { port = 123; }; | ||
4 | services = { | ||
5 | httpd.enable = true; | ||
6 | }; | ||
7 | } | ||
diff --git a/test/testdata/parse-okay-regression-20041027.exp b/test/testdata/parse-okay-regression-20041027.exp new file mode 100644 index 0000000..9df7219 --- /dev/null +++ b/test/testdata/parse-okay-regression-20041027.exp | |||
@@ -0,0 +1 @@ | |||
({ fetchurl, stdenv }: ((stdenv).mkDerivation { name = "libXi-6.0.1"; src = (fetchurl { md5 = "7e935a42428d63a387b3c048be0f2756"; url = "http://freedesktop.org/~xlibs/release/libXi-6.0.1.tar.bz2"; }); })) | |||
diff --git a/test/testdata/parse-okay-regression-20041027.nix b/test/testdata/parse-okay-regression-20041027.nix new file mode 100644 index 0000000..ae2e256 --- /dev/null +++ b/test/testdata/parse-okay-regression-20041027.nix | |||
@@ -0,0 +1,11 @@ | |||
1 | {stdenv, fetchurl /* pkgconfig, libX11 */ }: | ||
2 | |||
3 | stdenv.mkDerivation { | ||
4 | name = "libXi-6.0.1"; | ||
5 | src = fetchurl { | ||
6 | url = http://freedesktop.org/~xlibs/release/libXi-6.0.1.tar.bz2; | ||
7 | md5 = "7e935a42428d63a387b3c048be0f2756"; | ||
8 | }; | ||
9 | /* buildInputs = [pkgconfig]; | ||
10 | propagatedBuildInputs = [libX11]; */ | ||
11 | } | ||
diff --git a/test/testdata/parse-okay-regression-751.exp b/test/testdata/parse-okay-regression-751.exp new file mode 100644 index 0000000..e2ed886 --- /dev/null +++ b/test/testdata/parse-okay-regression-751.exp | |||
@@ -0,0 +1 @@ | |||
(let const = (a: "const"); in ((const { x = "q"; }))) | |||
diff --git a/test/testdata/parse-okay-regression-751.nix b/test/testdata/parse-okay-regression-751.nix new file mode 100644 index 0000000..05c78b3 --- /dev/null +++ b/test/testdata/parse-okay-regression-751.nix | |||
@@ -0,0 +1,2 @@ | |||
1 | let const = a: "const"; in | ||
2 | ''${ const { x = "q"; }}'' | ||
diff --git a/test/testdata/parse-okay-subversion.exp b/test/testdata/parse-okay-subversion.exp new file mode 100644 index 0000000..32fbba3 --- /dev/null +++ b/test/testdata/parse-okay-subversion.exp | |||
@@ -0,0 +1 @@ | |||
({ db4 ? null, expat, fetchurl, httpServer ? false, httpd ? null, j2sdk ? null, javaSwigBindings ? false, javahlBindings ? false, localServer ? false, openssl ? null, pythonBindings ? false, sslSupport ? false, stdenv, swig ? null }: assert (expat != null); assert (localServer -> (db4 != null)); assert (httpServer -> ((httpd != null) && ((httpd).expat == expat))); assert (sslSupport -> ((openssl != null) && (httpServer -> ((httpd).openssl == openssl)))); assert (pythonBindings -> ((swig != null) && (swig).pythonSupport)); assert (javaSwigBindings -> ((swig != null) && (swig).javaSupport)); assert (javahlBindings -> (j2sdk != null)); ((stdenv).mkDerivation { inherit expat httpServer javaSwigBindings javahlBindings localServer pythonBindings sslSupport; builder = /foo/bar; db4 = (if localServer then db4 else null); httpd = (if httpServer then httpd else null); j2sdk = (if javaSwigBindings then (swig).j2sdk else (if javahlBindings then j2sdk else null)); name = "subversion-1.1.1"; openssl = (if sslSupport then openssl else null); patches = (if javahlBindings then [ (/javahl.patch) ] else [ ]); python = (if pythonBindings then (swig).python else null); src = (fetchurl { md5 = "a180c3fe91680389c210c99def54d9e0"; url = "http://subversion.tigris.org/tarballs/subversion-1.1.1.tar.bz2"; }); swig = (if (pythonBindings || javaSwigBindings) then swig else null); })) | |||
diff --git a/test/testdata/parse-okay-subversion.nix b/test/testdata/parse-okay-subversion.nix new file mode 100644 index 0000000..3562728 --- /dev/null +++ b/test/testdata/parse-okay-subversion.nix | |||
@@ -0,0 +1,43 @@ | |||
1 | { localServer ? false | ||
2 | , httpServer ? false | ||
3 | , sslSupport ? false | ||
4 | , pythonBindings ? false | ||
5 | , javaSwigBindings ? false | ||
6 | , javahlBindings ? false | ||
7 | , stdenv, fetchurl | ||
8 | , openssl ? null, httpd ? null, db4 ? null, expat, swig ? null, j2sdk ? null | ||
9 | }: | ||
10 | |||
11 | assert expat != null; | ||
12 | assert localServer -> db4 != null; | ||
13 | assert httpServer -> httpd != null && httpd.expat == expat; | ||
14 | assert sslSupport -> openssl != null && (httpServer -> httpd.openssl == openssl); | ||
15 | assert pythonBindings -> swig != null && swig.pythonSupport; | ||
16 | assert javaSwigBindings -> swig != null && swig.javaSupport; | ||
17 | assert javahlBindings -> j2sdk != null; | ||
18 | |||
19 | stdenv.mkDerivation { | ||
20 | name = "subversion-1.1.1"; | ||
21 | |||
22 | builder = /foo/bar; | ||
23 | src = fetchurl { | ||
24 | url = http://subversion.tigris.org/tarballs/subversion-1.1.1.tar.bz2; | ||
25 | md5 = "a180c3fe91680389c210c99def54d9e0"; | ||
26 | }; | ||
27 | |||
28 | # This is a hopefully temporary fix for the problem that | ||
29 | # libsvnjavahl.so isn't linked against libstdc++, which causes | ||
30 | # loading the library into the JVM to fail. | ||
31 | patches = if javahlBindings then [/javahl.patch] else []; | ||
32 | |||
33 | openssl = if sslSupport then openssl else null; | ||
34 | httpd = if httpServer then httpd else null; | ||
35 | db4 = if localServer then db4 else null; | ||
36 | swig = if pythonBindings || javaSwigBindings then swig else null; | ||
37 | python = if pythonBindings then swig.python else null; | ||
38 | j2sdk = if javaSwigBindings then swig.j2sdk else | ||
39 | if javahlBindings then j2sdk else null; | ||
40 | |||
41 | inherit expat localServer httpServer sslSupport | ||
42 | pythonBindings javaSwigBindings javahlBindings; | ||
43 | } | ||
diff --git a/test/testdata/parse-okay-url.exp b/test/testdata/parse-okay-url.exp new file mode 100644 index 0000000..e5f0829 --- /dev/null +++ b/test/testdata/parse-okay-url.exp | |||
@@ -0,0 +1 @@ | |||
[ ("x:x") ("https://svn.cs.uu.nl:12443/repos/trace/trunk") ("http://www2.mplayerhq.hu/MPlayer/releases/fonts/font-arial-iso-8859-1.tar.bz2") ("http://losser.st-lab.cs.uu.nl/~armijn/.nix/gcc-3.3.4-static-nix.tar.gz") ("http://fpdownload.macromedia.com/get/shockwave/flash/english/linux/7.0r25/install_flash_player_7_linux.tar.gz") ("https://ftp5.gwdg.de/pub/linux/archlinux/extra/os/x86_64/unzip-6.0-14-x86_64.pkg.tar.zst") ("ftp://ftp.gtk.org/pub/gtk/v1.2/gtk+-1.2.10.tar.gz") ] | |||
diff --git a/test/testdata/parse-okay-url.nix b/test/testdata/parse-okay-url.nix new file mode 100644 index 0000000..08de27d --- /dev/null +++ b/test/testdata/parse-okay-url.nix | |||
@@ -0,0 +1,8 @@ | |||
1 | [ x:x | ||
2 | https://svn.cs.uu.nl:12443/repos/trace/trunk | ||
3 | http://www2.mplayerhq.hu/MPlayer/releases/fonts/font-arial-iso-8859-1.tar.bz2 | ||
4 | http://losser.st-lab.cs.uu.nl/~armijn/.nix/gcc-3.3.4-static-nix.tar.gz | ||
5 | http://fpdownload.macromedia.com/get/shockwave/flash/english/linux/7.0r25/install_flash_player_7_linux.tar.gz | ||
6 | https://ftp5.gwdg.de/pub/linux/archlinux/extra/os/x86_64/unzip-6.0-14-x86_64.pkg.tar.zst | ||
7 | ftp://ftp.gtk.org/pub/gtk/v1.2/gtk+-1.2.10.tar.gz | ||
8 | ] | ||
diff --git a/test/testdata/readDir/bar b/test/testdata/readDir/bar new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/test/testdata/readDir/bar | |||
diff --git a/test/testdata/readDir/foo/git-hates-directories b/test/testdata/readDir/foo/git-hates-directories new file mode 100644 index 0000000..e69de29 --- /dev/null +++ b/test/testdata/readDir/foo/git-hates-directories | |||
diff --git a/test/testdata/readDir/ldir b/test/testdata/readDir/ldir new file mode 120000 index 0000000..1910281 --- /dev/null +++ b/test/testdata/readDir/ldir | |||
@@ -0,0 +1 @@ | |||
foo \ No newline at end of file | |||
diff --git a/test/testdata/readDir/linked b/test/testdata/readDir/linked new file mode 120000 index 0000000..c503f86 --- /dev/null +++ b/test/testdata/readDir/linked | |||
@@ -0,0 +1 @@ | |||
foo/git-hates-directories \ No newline at end of file | |||
diff --git a/test/testdata/symlink-resolution/broken b/test/testdata/symlink-resolution/broken new file mode 120000 index 0000000..e07da69 --- /dev/null +++ b/test/testdata/symlink-resolution/broken | |||
@@ -0,0 +1 @@ | |||
nonexistent \ No newline at end of file | |||
diff --git a/test/testdata/symlink-resolution/foo/lib/default.nix b/test/testdata/symlink-resolution/foo/lib/default.nix new file mode 100644 index 0000000..8b8441b --- /dev/null +++ b/test/testdata/symlink-resolution/foo/lib/default.nix | |||
@@ -0,0 +1 @@ | |||
"test" | |||
diff --git a/test/testdata/symlink-resolution/foo/overlays b/test/testdata/symlink-resolution/foo/overlays new file mode 120000 index 0000000..0d44a21 --- /dev/null +++ b/test/testdata/symlink-resolution/foo/overlays | |||
@@ -0,0 +1 @@ | |||
../overlays \ No newline at end of file | |||
diff --git a/test/testdata/symlink-resolution/overlays/overlay.nix b/test/testdata/symlink-resolution/overlays/overlay.nix new file mode 100644 index 0000000..b036830 --- /dev/null +++ b/test/testdata/symlink-resolution/overlays/overlay.nix | |||
@@ -0,0 +1 @@ | |||
import ../lib | |||
diff --git a/theories/dune b/theories/dune new file mode 100644 index 0000000..0034b5d --- /dev/null +++ b/theories/dune | |||
@@ -0,0 +1,8 @@ | |||
1 | (include_subdirs qualified) | ||
2 | |||
3 | (coq.theory | ||
4 | (name mininix) | ||
5 | ; This ensures that all files are checked when using the install alias. | ||
6 | ; (This does not happen otherwise when just compiling the front-end.) | ||
7 | (package mininix) | ||
8 | (theories Flocq stdpp)) | ||
diff --git a/theories/dynlang/equiv.v b/theories/dynlang/equiv.v new file mode 100644 index 0000000..aa0b7f3 --- /dev/null +++ b/theories/dynlang/equiv.v | |||
@@ -0,0 +1,154 @@ | |||
1 | From mininix Require Export lambda.interp_proofs dynlang.interp_proofs. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Class Lift A B := lift : A → B. | ||
5 | Global Hint Mode Lift ! - : typeclass_instances. | ||
6 | Arguments lift {_ _ _} !_ /. | ||
7 | Notation "⌜ x ⌝" := (lift x) (at level 0). | ||
8 | Notation "⌜* x ⌝" := (fmap lift x) (at level 0). | ||
9 | |||
10 | Module lambda. | ||
11 | Global Instance lambda_expr_lift : Lift lambda.expr dynlang.expr := | ||
12 | fix go e := let _ : Lift _ _ := go in | ||
13 | match e with | ||
14 | | lambda.EString s => dynlang.EString s | ||
15 | | lambda.EId x => dynlang.EId ∅ (dynlang.EString x) | ||
16 | | lambda.EAbs x e => dynlang.EAbs (dynlang.EString x) ⌜e⌝ | ||
17 | | lambda.EApp e1 e2 => dynlang.EApp ⌜e1⌝ ⌜e2⌝ | ||
18 | end. | ||
19 | |||
20 | Global Instance lambda_thunk_lift : Lift lambda.thunk dynlang.thunk := | ||
21 | fix go t := let _ : Lift _ _ := go in | ||
22 | dynlang.Thunk ⌜*lambda.thunk_env t⌝ ⌜lambda.thunk_expr t⌝. | ||
23 | |||
24 | Global Instance lambda_val_lift : Lift lambda.val dynlang.val := λ v, | ||
25 | match v with | ||
26 | | lambda.VString s => dynlang.VString s | ||
27 | | lambda.VClo x E e => dynlang.VClo x ⌜*E⌝ ⌜e⌝ | ||
28 | end. | ||
29 | End lambda. | ||
30 | |||
31 | Lemma interp_open_lambda_dynlang E e mv n : | ||
32 | lambda.closed_env E → lambda.closed (dom E) e → | ||
33 | lambda.interp n E e = Res mv → | ||
34 | ∃ m, dynlang.interp m ⌜*E⌝ ⌜e⌝ = Res ⌜*mv⌝. | ||
35 | Proof. | ||
36 | revert E e mv. induction n as [|n IH]; [done|]; intros E e mv HE He Hinterp. | ||
37 | rewrite lambda.interp_S in Hinterp. destruct e as [s|z|ex e|e1 e2]; simplify_res. | ||
38 | - (* EString *) by exists 1. | ||
39 | - (* EId *) | ||
40 | apply elem_of_dom in He as [[Et et] Hz]. rewrite Hz /= in Hinterp. | ||
41 | apply lambda.closed_env_lookup in Hz as He; last done. | ||
42 | rewrite lambda.closed_thunk_eq/= in He. destruct He as [HEtclosed Hetclosed]. | ||
43 | apply IH in Hinterp as [m Hinterp]; [|done..]. | ||
44 | exists (S (S m)). rewrite !dynlang.interp_S /= -dynlang.interp_S. | ||
45 | rewrite lookup_empty /= right_id_L lookup_fmap Hz /=. | ||
46 | eauto using dynlang.interp_le with lia. | ||
47 | - (* EAbs *) by exists 2. | ||
48 | - (* EApp *) | ||
49 | destruct He as [He1 He2]. | ||
50 | destruct (lambda.interp _ _ e1) as [mw|] eqn:Hinterp1; simplify_res. | ||
51 | pose proof Hinterp1 as Hinterp1'. | ||
52 | apply lambda.interp_closed in Hinterp1' as Hmw; [|done..]. | ||
53 | eapply IH in Hinterp1 as [m1 Hinterp1]; [|done..]. | ||
54 | destruct mw as [w|]; simplify_res; last first. | ||
55 | { exists (S m1). by rewrite dynlang.interp_S /= Hinterp1. } | ||
56 | destruct (maybe3 lambda.VClo w) eqn:?; simplify_res; last first. | ||
57 | { exists (S m1). rewrite dynlang.interp_S /= Hinterp1 /=. by destruct w. } | ||
58 | destruct w; simplify_res. | ||
59 | apply IH in Hinterp as [m2 Hinterp2]. | ||
60 | + exists (S (m1 + m2)). rewrite dynlang.interp_S /=. | ||
61 | rewrite (dynlang.interp_le Hinterp1) /=; last lia. | ||
62 | rewrite fmap_insert /= in Hinterp2. | ||
63 | rewrite (dynlang.interp_le Hinterp2) /=; last lia. done. | ||
64 | + apply lambda.closed_env_insert; [by split|naive_solver]. | ||
65 | + rewrite dom_insert_L. set_solver. | ||
66 | Qed. | ||
67 | Lemma interp_lambda_dynlang e mv n : | ||
68 | lambda.closed ∅ e → | ||
69 | lambda.interp n ∅ e = Res mv → | ||
70 | ∃ m, dynlang.interp m ∅ ⌜e⌝ = Res ⌜*mv⌝. | ||
71 | Proof. intro. by apply interp_open_lambda_dynlang. Qed. | ||
72 | |||
73 | Lemma interp_open_dynlang_lambda E e mv n : | ||
74 | lambda.closed_env E → lambda.closed (dom E) e → | ||
75 | dynlang.interp n ⌜*E⌝ ⌜e⌝ = Res mv → | ||
76 | ∃ mw, lambda.interp n E e = Res mw ∧ mv = ⌜*mw⌝. | ||
77 | Proof. | ||
78 | revert E e mv. induction n as [|n IH]; [done|]; intros E e mv HE He Hinterp. | ||
79 | rewrite dynlang.interp_S in Hinterp. destruct e as [s|z|ex e|e1 e2]; simplify_res. | ||
80 | - (* EString *) rewrite lambda.interp_S /=. by eexists. | ||
81 | - (* EId *) | ||
82 | destruct n as [|n]; [done|]. | ||
83 | rewrite dynlang.interp_S /= -dynlang.interp_S in Hinterp. | ||
84 | apply elem_of_dom in He as [[Et et] Hz]. | ||
85 | pose proof (f_equal (fmap lift) Hz) as Hz'. | ||
86 | rewrite -lookup_fmap /= in Hz'. rewrite Hz' lookup_empty /= {Hz'} in Hinterp. | ||
87 | pose proof Hz as Hz'. | ||
88 | apply lambda.closed_env_lookup in Hz' as [HEt Het]; simpl in *; last done. | ||
89 | apply IH in Hinterp as (mw & Hinterp & ->); [|done..]. | ||
90 | exists mw. rewrite lambda.interp_S /= Hz /=. done. | ||
91 | - (* EAbs *) | ||
92 | destruct n as [|n]; [done|]. | ||
93 | rewrite dynlang.interp_S /= in Hinterp; simplify_res. | ||
94 | rewrite lambda.interp_S /=. by eexists. | ||
95 | - (* EApp *) | ||
96 | destruct He as [He1 He2]. | ||
97 | destruct (dynlang.interp _ _ _) as [mw1|] eqn:Hinterp1; simplify_res. | ||
98 | eapply IH in Hinterp1 as (mv1 & Hinterp1 & ->); [|done..]. | ||
99 | destruct mv1 as [v1|]; simplify_res; last first. | ||
100 | { exists None. by rewrite lambda.interp_S /= Hinterp1. } | ||
101 | destruct (maybe3 dynlang.VClo _) eqn:?; simplify_res; last first. | ||
102 | { exists None. rewrite lambda.interp_S /= Hinterp1 /=. by destruct v1. } | ||
103 | destruct v1; simplify_res. | ||
104 | change (dynlang.Thunk ⌜*E⌝ ⌜e2⌝) with ⌜lambda.Thunk E e2⌝ in Hinterp. | ||
105 | rewrite -fmap_insert in Hinterp. | ||
106 | apply lambda.interp_closed in Hinterp1 as Hmw; [|done..]. | ||
107 | apply IH in Hinterp as (mv2 & Hinterp2 & ->). | ||
108 | + exists mv2. rewrite lambda.interp_S /= Hinterp1 /=. done. | ||
109 | + apply lambda.closed_env_insert; [by split|]. naive_solver. | ||
110 | + rewrite dom_insert_L. set_solver. | ||
111 | Qed. | ||
112 | Lemma interp_dynlang_lambda e mv n : | ||
113 | lambda.closed ∅ e → | ||
114 | dynlang.interp n ∅ ⌜e⌝ = Res mv → | ||
115 | ∃ mw, lambda.interp n ∅ e = Res mw ∧ mv = ⌜*mw⌝. | ||
116 | Proof. intros. by apply interp_open_dynlang_lambda. Qed. | ||
117 | |||
118 | (* The following equivalences about the semantics trivially follow: *) | ||
119 | |||
120 | Theorem interp_equiv_ret_string e s : | ||
121 | lambda.closed ∅ e → | ||
122 | rtc lambda.step e (lambda.EString s) | ||
123 | ↔ rtc dynlang.step ⌜e⌝ (dynlang.EString s). | ||
124 | Proof. | ||
125 | intros. rewrite -lambda.interp_sound_complete_ret_string //. | ||
126 | rewrite -dynlang.interp_sound_complete_ret_string. split; intros [n Hinterp]. | ||
127 | + by apply interp_lambda_dynlang in Hinterp. | ||
128 | + apply interp_dynlang_lambda in Hinterp as ([[]|] & ?); naive_solver. | ||
129 | Qed. | ||
130 | |||
131 | Theorem interp_equiv_fail e : | ||
132 | lambda.closed ∅ e → | ||
133 | (∃ e', rtc lambda.step e e' ∧ lambda.stuck e') | ||
134 | ↔ (∃ e', rtc dynlang.step ⌜e⌝ e' ∧ dynlang.stuck e'). | ||
135 | Proof. | ||
136 | intros. rewrite -lambda.interp_sound_complete_fail //. | ||
137 | rewrite -dynlang.interp_sound_complete_fail. split; intros [n Hinterp]. | ||
138 | + by apply interp_lambda_dynlang in Hinterp. | ||
139 | + apply interp_dynlang_lambda in Hinterp as ([] & ?); naive_solver. | ||
140 | Qed. | ||
141 | |||
142 | Theorem interp_equiv_no_fuel e : | ||
143 | lambda.closed ∅ e → | ||
144 | all_loop lambda.step e ↔ all_loop dynlang.step ⌜e⌝. | ||
145 | Proof. | ||
146 | intros He. rewrite -lambda.interp_sound_complete_no_fuel; last done. | ||
147 | rewrite -dynlang.interp_sound_complete_no_fuel. split; intros Hnofuel n. | ||
148 | - destruct (dynlang.interp n ∅ _) as [mv|] eqn:Hinterp; [|done]. | ||
149 | apply interp_dynlang_lambda in Hinterp as (? & Hinterp & _); [|done]. | ||
150 | by rewrite Hnofuel in Hinterp. | ||
151 | - destruct (lambda.interp n ∅ _) as [mv|] eqn:Hinterp; [|done]. | ||
152 | apply interp_lambda_dynlang in Hinterp as [m Hinterp]; [|done..]. | ||
153 | by rewrite Hnofuel in Hinterp. | ||
154 | Qed. | ||
diff --git a/theories/dynlang/interp.v b/theories/dynlang/interp.v new file mode 100644 index 0000000..dcf6b95 --- /dev/null +++ b/theories/dynlang/interp.v | |||
@@ -0,0 +1,49 @@ | |||
1 | From mininix Require Export res dynlang.operational_props. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import dynlang. | ||
5 | Export dynlang. | ||
6 | |||
7 | Inductive thunk := Thunk { thunk_env : gmap string thunk; thunk_expr : expr }. | ||
8 | Add Printing Constructor thunk. | ||
9 | Notation env := (gmap string thunk). | ||
10 | |||
11 | Inductive val := | ||
12 | | VString (s : string) | ||
13 | | VClo (x : string) (E : env) (e : expr). | ||
14 | |||
15 | Global Instance maybe_VString : Maybe VString := λ v, | ||
16 | if v is VString s then Some s else None. | ||
17 | Global Instance maybe_VClo : Maybe3 VClo := λ v, | ||
18 | if v is VClo x E e then Some (x, E, e) else None. | ||
19 | |||
20 | Definition interp1 (interp : env → expr → res val) (E : env) (e : expr) : res val := | ||
21 | match e with | ||
22 | | EString s => | ||
23 | mret (VString s) | ||
24 | | EId ds e => | ||
25 | v ← interp E e; | ||
26 | x ← Res $ maybe VString v; | ||
27 | t ← Res $ (E !! x) ∪ (Thunk ∅ <$> ds !! x); | ||
28 | interp (thunk_env t) (thunk_expr t) | ||
29 | | EAbs ex e => | ||
30 | v ← interp E ex; | ||
31 | x ← Res $ maybe VString v; | ||
32 | mret (VClo x E e) | ||
33 | | EApp e1 e2 => | ||
34 | v1 ← interp E e1; | ||
35 | '(x, E', e') ← Res (maybe3 VClo v1); | ||
36 | interp (<[x:=Thunk E e2]> E') e' | ||
37 | end. | ||
38 | |||
39 | Fixpoint interp (n : nat) (E : env) (e : expr) : res val := | ||
40 | match n with | ||
41 | | O => NoFuel | ||
42 | | S n => interp1 (interp n) E e | ||
43 | end. | ||
44 | |||
45 | Global Opaque interp. | ||
46 | |||
47 | End dynlang. | ||
48 | |||
49 | Add Printing Constructor dynlang.thunk. | ||
diff --git a/theories/dynlang/interp_proofs.v b/theories/dynlang/interp_proofs.v new file mode 100644 index 0000000..f18a91c --- /dev/null +++ b/theories/dynlang/interp_proofs.v | |||
@@ -0,0 +1,426 @@ | |||
1 | From mininix Require Export dynlang.interp. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import dynlang. | ||
5 | Export dynlang. | ||
6 | |||
7 | Lemma interp_S n : interp (S n) = interp1 (interp n). | ||
8 | Proof. done. Qed. | ||
9 | |||
10 | Fixpoint thunk_size (t : thunk) : nat := | ||
11 | S (map_sum_with thunk_size (thunk_env t)). | ||
12 | Definition env_size (E : env) : nat := | ||
13 | map_sum_with thunk_size E. | ||
14 | |||
15 | Lemma env_ind (P : env → Prop) : | ||
16 | (∀ E, map_Forall (λ i, P ∘ thunk_env) E → P E) → | ||
17 | ∀ E : env, P E. | ||
18 | Proof. | ||
19 | intros Pbs E. | ||
20 | induction (Nat.lt_wf_0_projected env_size E) as [E _ IH]. | ||
21 | apply Pbs, map_Forall_lookup=> y [E' e'] Hy. | ||
22 | apply (map_sum_with_lookup_le thunk_size) in Hy. | ||
23 | apply IH. by rewrite -Nat.le_succ_l. | ||
24 | Qed. | ||
25 | |||
26 | (** Correspondence to operational semantics *) | ||
27 | Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr := | ||
28 | subst (thunk_to_expr <$> E). | ||
29 | Fixpoint thunk_to_expr (t : thunk) : expr := | ||
30 | subst_env' thunk_to_expr (thunk_env t) (thunk_expr t). | ||
31 | Notation subst_env := (subst_env' thunk_to_expr). | ||
32 | |||
33 | Lemma subst_env_eq e E : | ||
34 | subst_env E e = | ||
35 | match e with | ||
36 | | EString s => EString s | ||
37 | | EId ds e => EId ((thunk_to_expr <$> E) ∪ ds) (subst_env E e) | ||
38 | | EAbs ex e => EAbs (subst_env E ex) (subst_env E e) | ||
39 | | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2) | ||
40 | end. | ||
41 | Proof. by destruct e. Qed. | ||
42 | |||
43 | Lemma subst_env_alt E e : subst_env E e = subst (thunk_to_expr <$> E) e. | ||
44 | Proof. done. Qed. | ||
45 | |||
46 | (* Use the unfolding lemmas, don't rely on conversion *) | ||
47 | Opaque subst_env'. | ||
48 | |||
49 | Definition val_to_expr (v : val) : expr := | ||
50 | match v with | ||
51 | | VString s => EString s | ||
52 | | VClo x E e => EAbs (EString x) (subst_env E e) | ||
53 | end. | ||
54 | |||
55 | Lemma val_final v : final (val_to_expr v). | ||
56 | Proof. by destruct v. Qed. | ||
57 | |||
58 | Lemma subst_empty e : subst ∅ e = e. | ||
59 | Proof. induction e; f_equal/=; auto. by rewrite left_id_L. Qed. | ||
60 | |||
61 | Lemma subst_env_empty e : subst_env ∅ e = e. | ||
62 | Proof. rewrite subst_env_alt. apply subst_empty. Qed. | ||
63 | |||
64 | Lemma interp_le {n1 n2 E e mv} : | ||
65 | interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv. | ||
66 | Proof. | ||
67 | revert n2 E e mv. | ||
68 | induction n1 as [|n1 IH]; intros [|n2] E e mv He ?; [by (done || lia)..|]. | ||
69 | rewrite interp_S in He; rewrite interp_S; destruct e; | ||
70 | repeat match goal with | ||
71 | | _ => case_match | ||
72 | | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res | ||
73 | | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res | ||
74 | | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res | ||
75 | | |- interp ?n ?E ?e ≫= _ = _ => erewrite (IH n E e) by (done || lia) | ||
76 | | _ => progress simplify_res | ||
77 | | _ => progress simplify_option_eq | ||
78 | end; eauto with lia. | ||
79 | Qed. | ||
80 | |||
81 | Lemma interp_agree {n1 n2 E e mv1 mv2} : | ||
82 | interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2. | ||
83 | Proof. | ||
84 | intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2). | ||
85 | - rewrite -He2. symmetry. eauto using interp_le. | ||
86 | - rewrite -He1. eauto using interp_le. | ||
87 | Qed. | ||
88 | |||
89 | Lemma subst_env_union E1 E2 e : | ||
90 | subst_env (E1 ∪ E2) e = subst_env E1 (subst_env E2 e). | ||
91 | Proof. | ||
92 | revert E1 E2. induction e; intros E1 E2; rewrite subst_env_eq /=. | ||
93 | - done. | ||
94 | - rewrite !(subst_env_eq (EId _ _)) IHe. f_equal. | ||
95 | by rewrite assoc_L map_fmap_union. | ||
96 | - rewrite !(subst_env_eq (EAbs _ _)) /=. f_equal; auto. | ||
97 | - rewrite !(subst_env_eq (EApp _ _)) /=. f_equal; auto. | ||
98 | Qed. | ||
99 | |||
100 | Lemma subst_env_insert E x e t : | ||
101 | subst_env (<[x:=t]> E) e = subst {[x:=thunk_to_expr t]} (subst_env E e). | ||
102 | Proof. | ||
103 | rewrite insert_union_singleton_l subst_env_union subst_env_alt. | ||
104 | by rewrite map_fmap_singleton. | ||
105 | Qed. | ||
106 | |||
107 | Lemma subst_env_insert_eq e1 e2 E1 E2 x E1' E2' e1' e2' : | ||
108 | subst_env E1 e1 = subst_env E2 e2 → | ||
109 | subst_env E1' e1' = subst_env E2' e2' → | ||
110 | subst_env (<[x:=Thunk E1' e1']> E1) e1 = subst_env (<[x:=Thunk E2' e2']> E2) e2. | ||
111 | Proof. intros He He'. by rewrite !subst_env_insert //= He' He. Qed. | ||
112 | |||
113 | Lemma interp_proper n E1 E2 e1 e2 mv : | ||
114 | subst_env E1 e1 = subst_env E2 e2 → | ||
115 | interp n E1 e1 = Res mv → | ||
116 | ∃ mw m, interp m E2 e2 = Res mw ∧ | ||
117 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
118 | Proof. | ||
119 | revert n E1 E2 e1 e2 mv. induction n as [|n IHn]; [done|]. | ||
120 | intros E1 E2 e1 e2 mv Hsubst Hinterp. | ||
121 | rewrite 2!subst_env_eq in Hsubst. | ||
122 | rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done. | ||
123 | - eexists (Some (VString _)), 1. by rewrite interp_S. | ||
124 | - destruct (interp n _ e1) as [mv1|] eqn:Hinterp'; simplify_eq/=. | ||
125 | eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done. | ||
126 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
127 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
128 | destruct (maybe VString v1) as [x|] eqn:Hv1; | ||
129 | simplify_res; last first. | ||
130 | { exists None, (S m1). split; [|done]. rewrite interp_S /= Hinterp1 /=. | ||
131 | destruct v1, w1; repeat destruct select base_lit; by simplify_eq/=. } | ||
132 | destruct v1, w1; repeat destruct select base_lit; simplify_eq/=. | ||
133 | assert (∀ (ds : stringmap expr) (E : env) x, | ||
134 | thunk_to_expr <$> (E !! x) ∪ (Thunk ∅ <$> ds !! x) | ||
135 | = ((thunk_to_expr <$> E) ∪ ds) !! x) as HE. | ||
136 | { intros ds' E x. rewrite lookup_union lookup_fmap. | ||
137 | repeat destruct (_ !! _); f_equal/=; by rewrite subst_env_empty. } | ||
138 | pose proof (f_equal (.!! s0) Hsubst) as Hs. rewrite -!HE {HE} in Hs. | ||
139 | destruct (E1 !! s0 ∪ _) as [[E1' e1']|], | ||
140 | (E2 !! s0 ∪ _) as [[E2' e2']|] eqn:HE2; simplify_res; last first. | ||
141 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. by rewrite HE2. } | ||
142 | eapply IHn in Hinterp as (mw & m2 & Hinterp2 & ?); [|by eauto..]. | ||
143 | exists mw, (S (m1 `max` m2)). split; [|done]. rewrite interp_S /=. | ||
144 | rewrite (interp_le Hinterp1) /=; last lia. rewrite HE2 /=. | ||
145 | eauto using interp_le with lia. | ||
146 | - destruct (interp n _ _) as [mv1|] eqn:Hinterp'; simplify_eq/=. | ||
147 | eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done. | ||
148 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
149 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
150 | destruct (maybe VString _) eqn:Hstring; simplify_res; last first. | ||
151 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
152 | by assert (maybe VString w1 = None) as -> by (by destruct v1, w1). } | ||
153 | destruct v1, w1; simplify_eq/=. | ||
154 | eexists (Some (VClo _ _ _)), (S m1). | ||
155 | rewrite interp_S /= Hinterp1 /=. split; [done|]. by do 2 f_equal/=. | ||
156 | - destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
157 | eapply IHn in Hinterp' as (mw' & m1 & Hinterp1 & ?); last done. | ||
158 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
159 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
160 | destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first. | ||
161 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
162 | by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). } | ||
163 | destruct v', w'; simplify_eq/=. | ||
164 | eapply IHn with (E2 := <[x0:=Thunk E2 e2_2]> E0) in Hinterp | ||
165 | as (w & m2 & Hinterp2 & ?); last by apply subst_env_insert_eq. | ||
166 | exists w, (S (m1 `max` m2)). rewrite interp_S /=. | ||
167 | rewrite (interp_le Hinterp1) /=; last lia. | ||
168 | rewrite (interp_le Hinterp2) /=; last lia. done. | ||
169 | Qed. | ||
170 | |||
171 | Lemma subst_as_subst_env x e1 e2 : | ||
172 | subst {[x:=e2]} e1 = subst_env (<[x:=Thunk ∅ e2]> ∅) e1. | ||
173 | Proof. rewrite subst_env_insert //= !subst_env_empty //. Qed. | ||
174 | |||
175 | Lemma interp_subst n x e1 e2 mv : | ||
176 | interp n ∅ (subst {[x:=e2]} e1) = Res mv → | ||
177 | ∃ mw m, interp m (<[x:=Thunk ∅ e2]> ∅) e1 = Res mw ∧ | ||
178 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
179 | Proof. | ||
180 | apply interp_proper. | ||
181 | by rewrite subst_env_empty subst_as_subst_env. | ||
182 | Qed. | ||
183 | |||
184 | Lemma interp_step e1 e2 n mv : | ||
185 | e1 --> e2 → | ||
186 | interp n ∅ e2 = Res mv → | ||
187 | ∃ mw m, interp m ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw. | ||
188 | Proof. | ||
189 | intros Hstep. revert mv n. | ||
190 | induction Hstep; intros mv n Hinterp. | ||
191 | - apply interp_subst in Hinterp as (w & [|m] & Hinterp & Hv); | ||
192 | simplify_eq/=; [|done..]. | ||
193 | exists w, (S (S (S m))). rewrite !interp_S /= -!interp_S. | ||
194 | eauto using interp_le with lia. | ||
195 | - exists mv, (S (S n)). rewrite !interp_S /= -interp_S. | ||
196 | rewrite lookup_empty left_id_L H /=. eauto using interp_le with lia. | ||
197 | - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
198 | destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
199 | apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res. | ||
200 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
201 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
202 | destruct (maybe VString _) eqn:Hstring; simplify_res; last first. | ||
203 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
204 | by assert (maybe VString w' = None) as -> by (by destruct v', w'). } | ||
205 | destruct v', w'; simplify_eq/=. | ||
206 | eexists (Some (VClo _ _ _)), (S m1). rewrite !interp_S /=. | ||
207 | rewrite (interp_le Hinterp1) /=; last lia. done. | ||
208 | - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
209 | destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
210 | apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res. | ||
211 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
212 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
213 | destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first. | ||
214 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
215 | by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). } | ||
216 | destruct v', w'; simplify_eq/=. | ||
217 | eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & Hv); | ||
218 | last apply subst_env_insert_eq; try done. | ||
219 | exists mw, (S (m1 `max` m2)). rewrite !interp_S /=. | ||
220 | rewrite (interp_le Hinterp1) /=; last lia. | ||
221 | by rewrite (interp_le Hinterp2) /=; last lia. | ||
222 | - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
223 | destruct (interp n _ e1') as [mv1|] eqn:Hinterp1; simplify_eq/=. | ||
224 | apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1). | ||
225 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
226 | { exists None, (S m). by rewrite interp_S /= Hinterp1. } | ||
227 | exists mv, (S (n `max` m)). split; [|done]. | ||
228 | rewrite interp_S /= (interp_le Hinterp1) /=; last lia. | ||
229 | assert (maybe VString w1 = maybe VString v1) as ->. | ||
230 | { destruct v1, w1; naive_solver. } | ||
231 | destruct (maybe VString v1); simplify_res; [|done]. | ||
232 | destruct (_ ∪ _); simplify_res; eauto using interp_le with lia. | ||
233 | Qed. | ||
234 | |||
235 | Lemma final_interp e : | ||
236 | final e → | ||
237 | ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w. | ||
238 | Proof. | ||
239 | induction e as [| |[]|]; inv 1. | ||
240 | - eexists (VString _), 1. by rewrite interp_S /=. | ||
241 | - eexists (VClo _ _ _), 2. rewrite interp_S /=. split; [done|]. | ||
242 | by rewrite subst_env_empty. | ||
243 | Qed. | ||
244 | |||
245 | Lemma red_final_interp e : | ||
246 | red step e ∨ final e ∨ ∃ m, interp m ∅ e = mfail. | ||
247 | Proof. | ||
248 | induction e. | ||
249 | - (* ENat *) right; left. constructor. | ||
250 | - (* EId *) destruct IHe as [[??]|[Hfinal|[m Hinterp]]]. | ||
251 | + left. by repeat econstructor. | ||
252 | + apply final_interp in Hfinal as (w & m & Hinterp & ->). | ||
253 | destruct (maybe VString w) as [x|] eqn:Hw; last first. | ||
254 | { do 2 right. eexists (S m). rewrite interp_S /= Hinterp /=. | ||
255 | by rewrite Hw. } | ||
256 | destruct w; simplify_eq/=. | ||
257 | destruct (ds !! x) as [e|] eqn:Hx; last first. | ||
258 | { do 2 right. eexists (S m). rewrite interp_S /= Hinterp /=. | ||
259 | by rewrite Hx. } | ||
260 | left. by repeat econstructor. | ||
261 | + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done. | ||
262 | - (* EAbs *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]]. | ||
263 | + left. by repeat econstructor. | ||
264 | + apply final_interp in Hfinal as (w & m & Hinterp & ->). | ||
265 | destruct (maybe VString w) as [x|] eqn:Hw; last first. | ||
266 | { do 2 right. eexists (S m). rewrite interp_S /= Hinterp /=. | ||
267 | by rewrite Hw. } | ||
268 | destruct w; naive_solver. | ||
269 | + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done. | ||
270 | - (* EApp *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]]. | ||
271 | + left. by repeat econstructor. | ||
272 | + apply final_interp in Hfinal as (w & m & Hinterp & ->). | ||
273 | destruct (maybe3 VClo w) eqn:Hw. | ||
274 | { destruct w; simplify_eq/=. left. by repeat econstructor. } | ||
275 | do 2 right. exists (S m). by rewrite interp_S /= Hinterp /= Hw. | ||
276 | + do 2 right. exists (S m). by rewrite interp_S /= Hinterp. | ||
277 | Qed. | ||
278 | |||
279 | Lemma interp_complete e1 e2 : | ||
280 | e1 -->* e2 → | ||
281 | nf step e2 → | ||
282 | ∃ mw m, interp m ∅ e1 = Res mw ∧ | ||
283 | if mw is Some w then e2 = val_to_expr w else ¬final e2. | ||
284 | Proof. | ||
285 | intros Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH]. | ||
286 | { destruct (red_final_interp e) as [?|[Hfinal|[m Hinterp]]]; [done|..]. | ||
287 | - apply final_interp in Hfinal as (w & m & ? & ?). | ||
288 | by exists (Some w), m. | ||
289 | - exists None, m. split; [done|]. intros Hfinal. | ||
290 | apply final_interp in Hfinal as (w & m' & ? & _). | ||
291 | by assert (mfail = mret w) by eauto using interp_agree. } | ||
292 | destruct IH as (mw & m & Hinterp & ?); try done. | ||
293 | eapply interp_step in Hinterp as (mw' & m' & ? & ?); last done. | ||
294 | destruct mw, mw'; naive_solver. | ||
295 | Qed. | ||
296 | |||
297 | Lemma interp_complete_ret e1 e2 : | ||
298 | e1 -->* e2 → final e2 → | ||
299 | ∃ w m, interp m ∅ e1 = mret w ∧ e2 = val_to_expr w. | ||
300 | Proof. | ||
301 | intros Hsteps Hfinal. apply interp_complete in Hsteps | ||
302 | as ([w|] & m & ? & ?); naive_solver eauto using final_nf. | ||
303 | Qed. | ||
304 | Lemma interp_complete_fail e1 e2 : | ||
305 | e1 -->* e2 → nf step e2 → ¬final e2 → | ||
306 | ∃ m, interp m ∅ e1 = mfail. | ||
307 | Proof. | ||
308 | intros Hsteps Hnf Hforce. | ||
309 | apply interp_complete in Hsteps as ([w|] & m & ? & ?); simplify_eq/=; try by eauto. | ||
310 | destruct Hforce. apply val_final. | ||
311 | Qed. | ||
312 | |||
313 | Lemma interp_sound_open E e n mv : | ||
314 | interp n E e = Res mv → | ||
315 | ∃ e', subst_env E e -->* e' ∧ | ||
316 | if mv is Some v then e' = val_to_expr v else stuck e'. | ||
317 | Proof. | ||
318 | revert E e mv. | ||
319 | induction n as [|n IH]; intros E e mv Hinterp; first done. | ||
320 | rewrite subst_env_eq. rewrite interp_S in Hinterp. | ||
321 | destruct e; simplify_res. | ||
322 | - (* EString *) by eexists. | ||
323 | - (* EId *) | ||
324 | destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res. | ||
325 | apply IH in Hinterp1 as (e1' & Hsteps1 & He1'). | ||
326 | destruct mv1 as [v1|]; simplify_res; last first. | ||
327 | { eexists; split; [by eapply SId_rtc|]. split; [|inv 1]. | ||
328 | intros [??]. destruct He1' as [Hnf []]. | ||
329 | inv_step; simpl; eauto. destruct Hnf; eauto. } | ||
330 | destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first. | ||
331 | { eexists; split; [by eapply SId_rtc|]. split; [|inv 1]. | ||
332 | intros [??]. destruct v1; inv_step. } | ||
333 | destruct v1; simplify_eq/=. | ||
334 | assert (thunk_to_expr <$> (E !! x) ∪ (Thunk ∅ <$> ds !! x) | ||
335 | = ((thunk_to_expr <$> E) ∪ ds) !! x). | ||
336 | { rewrite lookup_union lookup_fmap. | ||
337 | repeat destruct (_ !! _); f_equal/=; by rewrite subst_env_empty. } | ||
338 | destruct (_ ∪ _) as [[E' e']|] eqn:Hx; simplify_res. | ||
339 | * apply IH in Hinterp as (e'' & Hsteps & He''). | ||
340 | exists e''; split; [|done]. etrans; [by eapply SId_rtc|]. | ||
341 | eapply rtc_l; [|done]. by econstructor. | ||
342 | * eexists; split; [by eapply SId_rtc|]. split; [|inv 1]. | ||
343 | intros [? Hstep]. inv_step; simplify_eq/=; congruence. | ||
344 | - (* EAbs *) | ||
345 | destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res. | ||
346 | apply IH in Hinterp1 as (e1' & Hsteps1 & He1'). | ||
347 | destruct mv1 as [v1|]; simplify_res; last first. | ||
348 | { eexists; split; [by eapply SAbsL_rtc|]. split. | ||
349 | + intros [??]. destruct He1' as [Hnf []]. | ||
350 | inv_step; simpl; eauto. destruct Hnf; eauto. | ||
351 | + intros ?. destruct He1' as [_ []]. by destruct e1'. } | ||
352 | eexists; split; [by eapply SAbsL_rtc|]. | ||
353 | destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first. | ||
354 | { split; [|destruct v1; inv 1]. intros [??]. destruct v1; inv_step. } | ||
355 | by destruct v1; simplify_eq/=. | ||
356 | - (* EApp *) destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
357 | apply IH in Hinterp' as (e' & Hsteps & He'); try done. | ||
358 | destruct mv' as [v'|]; simplify_res; last first. | ||
359 | { eexists; repeat split; [by apply SAppL_rtc| |inv 1]. | ||
360 | intros [e'' Hstep]. destruct He' as [Hnf Hfinal]. | ||
361 | inv Hstep; [by destruct Hfinal; constructor|]. destruct Hnf. eauto. } | ||
362 | destruct (maybe3 VClo v') eqn:?; simplify_res; last first. | ||
363 | { eexists; repeat split; [by apply SAppL_rtc| |inv 1]. | ||
364 | intros [e'' Hstep]. inv Hstep; destruct v'; by repeat inv_step. } | ||
365 | destruct v'; simplify_res. | ||
366 | apply IH in Hinterp as (e'' & Hsteps' & He''). | ||
367 | eexists; split; [|done]. etrans; [by apply SAppL_rtc|]. | ||
368 | eapply rtc_l; first by constructor. | ||
369 | rewrite subst_env_insert // in Hsteps'. | ||
370 | Qed. | ||
371 | |||
372 | Lemma interp_sound n e mv : | ||
373 | interp n ∅ e = Res mv → | ||
374 | ∃ e', e -->* e' ∧ if mv is Some v then e' = val_to_expr v else stuck e'. | ||
375 | Proof. | ||
376 | intros Hsteps%interp_sound_open; try done. | ||
377 | by rewrite subst_env_empty in Hsteps. | ||
378 | Qed. | ||
379 | |||
380 | (** Final theorems *) | ||
381 | Theorem interp_sound_complete_ret e v : | ||
382 | (∃ w n, interp n ∅ e = mret w ∧ val_to_expr v = val_to_expr w) | ||
383 | ↔ e -->* val_to_expr v. | ||
384 | Proof. | ||
385 | split. | ||
386 | - by intros (n & w & (e' & ? & ->)%interp_sound & ->). | ||
387 | - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?); | ||
388 | eauto using val_final. | ||
389 | Qed. | ||
390 | |||
391 | Theorem interp_sound_complete_ret_string e s : | ||
392 | (∃ n, interp n ∅ e = mret (VString s)) ↔ e -->* EString s. | ||
393 | Proof. | ||
394 | split. | ||
395 | - by intros [n (e' & ? & ->)%interp_sound]. | ||
396 | - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?); | ||
397 | simplify_eq/=; eauto. | ||
398 | Qed. | ||
399 | |||
400 | Theorem interp_sound_complete_fail e : | ||
401 | (∃ n, interp n ∅ e = mfail) ↔ ∃ e', e -->* e' ∧ stuck e'. | ||
402 | Proof. | ||
403 | split. | ||
404 | - by intros [n ?%interp_sound]. | ||
405 | - intros (e' & Hsteps & Hnf & Hforced). by eapply interp_complete_fail. | ||
406 | Qed. | ||
407 | |||
408 | Theorem interp_sound_complete_no_fuel e : | ||
409 | (∀ n, interp n ∅ e = NoFuel) ↔ all_loop step e. | ||
410 | Proof. | ||
411 | rewrite all_loop_alt. split. | ||
412 | - intros Hnofuel e' Hsteps. | ||
413 | destruct (red_final_interp e') as [|[|He']]; [done|..]. | ||
414 | + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); last done. | ||
415 | by rewrite Hnofuel in Hinterp. | ||
416 | + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]). | ||
417 | destruct (interp_complete e e'') as (mv & n & Hinterp & _); [by etrans|done|]. | ||
418 | by rewrite Hnofuel in Hinterp. | ||
419 | - intros Hred n. destruct (interp n ∅ e) as [mv|] eqn:Hinterp; [|done]. | ||
420 | apply interp_sound in Hinterp as (e' & Hsteps%Hred & Hstuck). | ||
421 | destruct mv as [v|]; simplify_eq/=. | ||
422 | + apply final_nf in Hsteps as []. apply val_final. | ||
423 | + by destruct Hstuck as [[] ?]. | ||
424 | Qed. | ||
425 | |||
426 | End dynlang. | ||
diff --git a/theories/dynlang/operational.v b/theories/dynlang/operational.v new file mode 100644 index 0000000..34cca7b --- /dev/null +++ b/theories/dynlang/operational.v | |||
@@ -0,0 +1,41 @@ | |||
1 | From mininix Require Export utils. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import dynlang. | ||
5 | |||
6 | Inductive expr := | ||
7 | | EString (s : string) | ||
8 | | EId (ds : gmap string expr) (ex : expr) | ||
9 | | EAbs (ex e : expr) | ||
10 | | EApp (e1 e2 : expr). | ||
11 | |||
12 | Fixpoint subst (ds : gmap string expr) (e : expr) : expr := | ||
13 | match e with | ||
14 | | EString s => EString s | ||
15 | | EId ds' e => EId (ds ∪ ds') (subst ds e) | ||
16 | | EAbs ex e => EAbs (subst ds ex) (subst ds e) | ||
17 | | EApp e1 e2 => EApp (subst ds e1) (subst ds e2) | ||
18 | end. | ||
19 | |||
20 | Reserved Infix "-->" (right associativity, at level 55). | ||
21 | Inductive step : expr → expr → Prop := | ||
22 | | Sβ x e1 e2 : EApp (EAbs (EString x) e1) e2 --> subst {[x:=e2]} e1 | ||
23 | | SIdString ds x e : ds !! x = Some e → EId ds (EString x) --> e | ||
24 | | SAbsL ex1 ex1' e : ex1 --> ex1' → EAbs ex1 e --> EAbs ex1' e | ||
25 | | SAppL e1 e1' e2 : e1 --> e1' → EApp e1 e2 --> EApp e1' e2 | ||
26 | | SId ds e1 e1' : e1 --> e1' → EId ds e1 --> EId ds e1' | ||
27 | where "e1 --> e2" := (step e1 e2). | ||
28 | |||
29 | Infix "-->*" := (rtc step) (right associativity, at level 55). | ||
30 | |||
31 | Definition final (e : expr) : Prop := | ||
32 | match e with | ||
33 | | EString _ => True | ||
34 | | EAbs (EString _) _ => True | ||
35 | | _ => False | ||
36 | end. | ||
37 | |||
38 | Definition stuck (e : expr) : Prop := | ||
39 | nf step e ∧ ¬final e. | ||
40 | |||
41 | End dynlang. | ||
diff --git a/theories/dynlang/operational_props.v b/theories/dynlang/operational_props.v new file mode 100644 index 0000000..9e8028c --- /dev/null +++ b/theories/dynlang/operational_props.v | |||
@@ -0,0 +1,33 @@ | |||
1 | From mininix Require Export dynlang.operational. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import dynlang. | ||
5 | Export dynlang. | ||
6 | |||
7 | (** Properties of operational semantics *) | ||
8 | Lemma step_not_final e1 e2 : e1 --> e2 → ¬final e1. | ||
9 | Proof. induction 1; simpl; repeat case_match; naive_solver. Qed. | ||
10 | Lemma final_nf e : final e → nf step e. | ||
11 | Proof. by intros ? [??%step_not_final]. Qed. | ||
12 | |||
13 | Lemma SAbsL_rtc ex1 ex1' e : ex1 -->* ex1' → EAbs ex1 e -->* EAbs ex1' e. | ||
14 | Proof. induction 1; econstructor; eauto using step. Qed. | ||
15 | Lemma SAppL_rtc e1 e1' e2 : e1 -->* e1' → EApp e1 e2 -->* EApp e1' e2. | ||
16 | Proof. induction 1; econstructor; eauto using step. Qed. | ||
17 | Lemma SId_rtc ds e1 e1' : e1 -->* e1' → EId ds e1 -->* EId ds e1'. | ||
18 | Proof. induction 1; econstructor; eauto using step. Qed. | ||
19 | |||
20 | Ltac inv_step := repeat | ||
21 | match goal with H : ?e --> _ |- _ => assert_fails (is_var e); inv H end. | ||
22 | |||
23 | Lemma step_det e d1 d2 : | ||
24 | e --> d1 → | ||
25 | e --> d2 → | ||
26 | d1 = d2. | ||
27 | Proof. | ||
28 | intros Hred1. revert d2. | ||
29 | induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step; | ||
30 | f_equal; by apply IHHred1. | ||
31 | Qed. | ||
32 | |||
33 | End dynlang. | ||
diff --git a/theories/evallang/interp.v b/theories/evallang/interp.v new file mode 100644 index 0000000..d98b87f --- /dev/null +++ b/theories/evallang/interp.v | |||
@@ -0,0 +1,52 @@ | |||
1 | From mininix Require Export res evallang.operational_props. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import evallang. | ||
5 | Export evallang. | ||
6 | |||
7 | Inductive thunk := Thunk { thunk_env : gmap string thunk; thunk_expr : expr }. | ||
8 | Add Printing Constructor thunk. | ||
9 | Notation env := (gmap string thunk). | ||
10 | |||
11 | Inductive val := | ||
12 | | VString (s : string) | ||
13 | | VClo (x : string) (E : env) (e : expr). | ||
14 | |||
15 | Global Instance maybe_VString : Maybe VString := λ v, | ||
16 | if v is VString s then Some s else None. | ||
17 | Global Instance maybe_VClo : Maybe3 VClo := λ v, | ||
18 | if v is VClo x E e then Some (x, E, e) else None. | ||
19 | |||
20 | Definition interp1 (interp : env → expr → res val) (E : env) (e : expr) : res val := | ||
21 | match e with | ||
22 | | EString s => | ||
23 | mret (VString s) | ||
24 | | EId ds x => | ||
25 | t ← Res $ (E !! x) ∪ (Thunk ∅ <$> ds); | ||
26 | interp (thunk_env t) (thunk_expr t) | ||
27 | | EEval ds e => | ||
28 | v ← interp E e; | ||
29 | s ← Res $ maybe VString v; | ||
30 | e ← Res $ parse s; | ||
31 | interp (E ∪ (Thunk ∅ <$> ds)) e | ||
32 | | EAbs ex e => | ||
33 | v ← interp E ex; | ||
34 | x ← Res $ maybe VString v; | ||
35 | mret (VClo x E e) | ||
36 | | EApp e1 e2 => | ||
37 | v1 ← interp E e1; | ||
38 | '(x, E', e') ← Res (maybe3 VClo v1); | ||
39 | interp (<[x:=Thunk E e2]> E') e' | ||
40 | end. | ||
41 | |||
42 | Fixpoint interp (n : nat) (E : env) (e : expr) : res val := | ||
43 | match n with | ||
44 | | O => NoFuel | ||
45 | | S n => interp1 (interp n) E e | ||
46 | end. | ||
47 | |||
48 | Global Opaque interp. | ||
49 | |||
50 | End evallang. | ||
51 | |||
52 | Add Printing Constructor evallang.thunk. | ||
diff --git a/theories/evallang/interp_proofs.v b/theories/evallang/interp_proofs.v new file mode 100644 index 0000000..0a26dd1 --- /dev/null +++ b/theories/evallang/interp_proofs.v | |||
@@ -0,0 +1,478 @@ | |||
1 | From mininix Require Export evallang.interp. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import evallang. | ||
5 | Export evallang. | ||
6 | |||
7 | Lemma interp_S n : interp (S n) = interp1 (interp n). | ||
8 | Proof. done. Qed. | ||
9 | |||
10 | Fixpoint thunk_size (t : thunk) : nat := | ||
11 | S (map_sum_with thunk_size (thunk_env t)). | ||
12 | Definition env_size (E : env) : nat := | ||
13 | map_sum_with thunk_size E. | ||
14 | |||
15 | Lemma env_ind (P : env → Prop) : | ||
16 | (∀ E, map_Forall (λ i, P ∘ thunk_env) E → P E) → | ||
17 | ∀ E : env, P E. | ||
18 | Proof. | ||
19 | intros Pbs E. | ||
20 | induction (Nat.lt_wf_0_projected env_size E) as [E _ IH]. | ||
21 | apply Pbs, map_Forall_lookup=> y [E' e'] Hy. | ||
22 | apply (map_sum_with_lookup_le thunk_size) in Hy. | ||
23 | apply IH. by rewrite -Nat.le_succ_l. | ||
24 | Qed. | ||
25 | |||
26 | (** Correspondence to operational semantics *) | ||
27 | Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr := | ||
28 | subst (thunk_to_expr <$> E). | ||
29 | Fixpoint thunk_to_expr (t : thunk) : expr := | ||
30 | subst_env' thunk_to_expr (thunk_env t) (thunk_expr t). | ||
31 | Notation subst_env := (subst_env' thunk_to_expr). | ||
32 | |||
33 | Lemma subst_env_eq e E : | ||
34 | subst_env E e = | ||
35 | match e with | ||
36 | | EString s => EString s | ||
37 | | EId ds x => EId ((thunk_to_expr <$> E !! x) ∪ ds) x | ||
38 | | EEval ds e => EEval ((thunk_to_expr <$> E) ∪ ds) (subst_env E e) | ||
39 | | EAbs ex e => EAbs (subst_env E ex) (subst_env E e) | ||
40 | | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2) | ||
41 | end. | ||
42 | Proof. destruct e; rewrite /subst_env' /= ?lookup_fmap //. Qed. | ||
43 | |||
44 | Lemma subst_env_alt E e : subst_env E e = subst (thunk_to_expr <$> E) e. | ||
45 | Proof. done. Qed. | ||
46 | |||
47 | (* Use the unfolding lemmas, don't rely on conversion *) | ||
48 | Opaque subst_env'. | ||
49 | |||
50 | Definition val_to_expr (v : val) : expr := | ||
51 | match v with | ||
52 | | VString s => EString s | ||
53 | | VClo x E e => EAbs (EString x) (subst_env E e) | ||
54 | end. | ||
55 | |||
56 | Lemma final_val_to_expr v : final (val_to_expr v). | ||
57 | Proof. by destruct v. Qed. | ||
58 | Lemma step_not_val_to_expr v e : val_to_expr v --> e → False. | ||
59 | Proof. intros []%step_not_final. apply final_val_to_expr. Qed. | ||
60 | |||
61 | Lemma subst_empty e : subst ∅ e = e. | ||
62 | Proof. induction e; f_equal/=; rewrite ?lookup_empty ?left_id_L //. Qed. | ||
63 | |||
64 | Lemma subst_env_empty e : subst_env ∅ e = e. | ||
65 | Proof. rewrite subst_env_alt. apply subst_empty. Qed. | ||
66 | |||
67 | Lemma interp_le {n1 n2 E e mv} : | ||
68 | interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv. | ||
69 | Proof. | ||
70 | revert n2 E e mv. | ||
71 | induction n1 as [|n1 IH]; intros [|n2] E e mv He ?; [by (done || lia)..|]. | ||
72 | rewrite interp_S in He; rewrite interp_S; destruct e; | ||
73 | repeat match goal with | ||
74 | | _ => case_match | ||
75 | | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res | ||
76 | | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res | ||
77 | | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res | ||
78 | | |- interp ?n ?E ?e ≫= _ = _ => erewrite (IH n E e) by (done || lia) | ||
79 | | _ => progress simplify_res | ||
80 | | _ => progress simplify_option_eq | ||
81 | end; eauto with lia. | ||
82 | Qed. | ||
83 | |||
84 | Lemma interp_agree {n1 n2 E e mv1 mv2} : | ||
85 | interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2. | ||
86 | Proof. | ||
87 | intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2). | ||
88 | - rewrite -He2. symmetry. eauto using interp_le. | ||
89 | - rewrite -He1. eauto using interp_le. | ||
90 | Qed. | ||
91 | |||
92 | Lemma subst_env_union E1 E2 e : | ||
93 | subst_env (E1 ∪ E2) e = subst_env E1 (subst_env E2 e). | ||
94 | Proof. | ||
95 | revert E1 E2. induction e; intros E1 E2; rewrite subst_env_eq /=. | ||
96 | - done. | ||
97 | - rewrite !subst_env_eq lookup_union. by destruct (E1 !! _), (E2 !! _), ds. | ||
98 | - rewrite !(subst_env_eq (EEval _ _)) IHe. f_equal. | ||
99 | by rewrite assoc_L map_fmap_union. | ||
100 | - rewrite !(subst_env_eq (EAbs _ _)) /=. f_equal; auto. | ||
101 | - rewrite !(subst_env_eq (EApp _ _)) /=. f_equal; auto. | ||
102 | Qed. | ||
103 | |||
104 | Lemma subst_env_insert E x e t : | ||
105 | subst_env (<[x:=t]> E) e = subst {[x:=thunk_to_expr t]} (subst_env E e). | ||
106 | Proof. | ||
107 | rewrite insert_union_singleton_l subst_env_union subst_env_alt. | ||
108 | by rewrite map_fmap_singleton. | ||
109 | Qed. | ||
110 | |||
111 | Lemma subst_env_insert_eq e1 e2 E1 E2 x E1' E2' e1' e2' : | ||
112 | subst_env E1 e1 = subst_env E2 e2 → | ||
113 | subst_env E1' e1' = subst_env E2' e2' → | ||
114 | subst_env (<[x:=Thunk E1' e1']> E1) e1 = subst_env (<[x:=Thunk E2' e2']> E2) e2. | ||
115 | Proof. intros He He'. by rewrite !subst_env_insert //= He' He. Qed. | ||
116 | |||
117 | Lemma option_fmap_thunk_to_expr_Thunk (me : option expr) : | ||
118 | thunk_to_expr <$> (Thunk ∅ <$> me) = me. | ||
119 | Proof. destruct me; f_equal/=. by rewrite subst_env_empty. Qed. | ||
120 | |||
121 | Lemma map_fmap_thunk_to_expr_Thunk (es : gmap string expr) : | ||
122 | thunk_to_expr <$> (Thunk ∅ <$> es) = es. | ||
123 | Proof. | ||
124 | apply map_eq=> x. by rewrite !lookup_fmap option_fmap_thunk_to_expr_Thunk. | ||
125 | Qed. | ||
126 | |||
127 | Lemma subst_env_eval_eq E1 E2 ds1 ds2 e : | ||
128 | (thunk_to_expr <$> E1) ∪ ds1 = (thunk_to_expr <$> E2) ∪ ds2 → | ||
129 | subst_env (E1 ∪ (Thunk ∅ <$> ds1)) e = subst_env (E2 ∪ (Thunk ∅ <$> ds2)) e. | ||
130 | Proof. | ||
131 | intros HE. | ||
132 | by rewrite !subst_env_alt !map_fmap_union !map_fmap_thunk_to_expr_Thunk HE. | ||
133 | Qed. | ||
134 | |||
135 | Lemma interp_proper n E1 E2 e1 e2 mv : | ||
136 | subst_env E1 e1 = subst_env E2 e2 → | ||
137 | interp n E1 e1 = Res mv → | ||
138 | ∃ mw m, interp m E2 e2 = Res mw ∧ | ||
139 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
140 | Proof. | ||
141 | revert n E1 E2 e1 e2 mv. induction n as [|n IHn]; [done|]. | ||
142 | intros E1 E2 e1 e2 mv Hsubst Hinterp. | ||
143 | rewrite 2!subst_env_eq in Hsubst. | ||
144 | rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done. | ||
145 | - eexists (Some (VString _)), 1. by rewrite interp_S. | ||
146 | - assert (thunk_to_expr <$> E1 !! x0 ∪ (Thunk ∅ <$> ds) = | ||
147 | thunk_to_expr <$> E2 !! x0 ∪ (Thunk ∅ <$> ds0)). | ||
148 | { destruct (E1 !! _), (E2 !! _), ds, ds0; simplify_eq/=; | ||
149 | f_equal/=; by rewrite ?subst_env_empty. } | ||
150 | destruct (E1 !! x0 ∪ (Thunk ∅ <$> ds)) as [[E1' e1']|], | ||
151 | (E2 !! x0 ∪ (Thunk ∅ <$> ds0)) as [[E2' e2']|] eqn:HE2; | ||
152 | simplify_res; last first. | ||
153 | { exists None, 1. by rewrite interp_S /= HE2. } | ||
154 | eapply IHn in Hinterp as (mw & m & Hinterp2 & ?); [|by eauto..]. | ||
155 | exists mw, (S m). split; [|done]. rewrite interp_S /= HE2 /=. done. | ||
156 | - destruct (interp n _ e1) as [mv1|] eqn:Hinterp'; simplify_eq/=. | ||
157 | eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done. | ||
158 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
159 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
160 | destruct (maybe VString v1) as [x|] eqn:Hv1; | ||
161 | simplify_res; last first. | ||
162 | { exists None, (S m1). split; [|done]. rewrite interp_S /= Hinterp1 /=. | ||
163 | destruct v1, w1; repeat destruct select base_lit; by simplify_eq/=. } | ||
164 | destruct v1, w1; repeat destruct select base_lit; simplify_eq/=. | ||
165 | destruct (parse _) as [e|] eqn:Hparse; simplify_res; last first. | ||
166 | { exists None, (S m1). split; [|done]. rewrite interp_S /= Hinterp1 /=. | ||
167 | by rewrite Hparse. } | ||
168 | eapply IHn in Hinterp | ||
169 | as (mw & m2 & Hinterp2 & ?); last by apply subst_env_eval_eq. | ||
170 | exists mw, (S (m1 `max` m2)). split; [|done]. rewrite interp_S /=. | ||
171 | rewrite (interp_le Hinterp1) /=; last lia. rewrite Hparse /=. | ||
172 | eauto using interp_le with lia. | ||
173 | - destruct (interp n _ _) as [mv1|] eqn:Hinterp'; simplify_eq/=. | ||
174 | eapply IHn in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done. | ||
175 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
176 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
177 | destruct (maybe VString _) eqn:Hstring; simplify_res; last first. | ||
178 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
179 | by assert (maybe VString w1 = None) as -> by (by destruct v1, w1). } | ||
180 | destruct v1, w1; simplify_eq/=. | ||
181 | eexists (Some (VClo _ _ _)), (S m1). | ||
182 | rewrite interp_S /= Hinterp1 /=. split; [done|]. by do 2 f_equal/=. | ||
183 | - destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
184 | eapply IHn in Hinterp' as (mw' & m1 & Hinterp1 & ?); last done. | ||
185 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
186 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
187 | destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first. | ||
188 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
189 | by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). } | ||
190 | destruct v', w'; simplify_eq/=. | ||
191 | eapply IHn with (E2 := <[x0:=Thunk E2 e2_2]> E0) in Hinterp | ||
192 | as (w & m2 & Hinterp2 & ?); last by apply subst_env_insert_eq. | ||
193 | exists w, (S (m1 `max` m2)). rewrite interp_S /=. | ||
194 | rewrite (interp_le Hinterp1) /=; last lia. | ||
195 | rewrite (interp_le Hinterp2) /=; last lia. done. | ||
196 | Qed. | ||
197 | |||
198 | Lemma subst_as_subst_env x e1 e2 : | ||
199 | subst {[x:=e2]} e1 = subst_env (<[x:=Thunk ∅ e2]> ∅) e1. | ||
200 | Proof. rewrite subst_env_insert //= !subst_env_empty //. Qed. | ||
201 | |||
202 | Lemma interp_subst_abs n x e1 e2 mv : | ||
203 | interp n ∅ (subst {[x:=e2]} e1) = Res mv → | ||
204 | ∃ mw m, interp m (<[x:=Thunk ∅ e2]> ∅) e1 = Res mw ∧ | ||
205 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
206 | Proof. | ||
207 | apply interp_proper. by rewrite subst_env_empty subst_as_subst_env. | ||
208 | Qed. | ||
209 | |||
210 | Lemma interp_subst_eval n e ds mv : | ||
211 | interp n ∅ (subst ds e) = Res mv → | ||
212 | ∃ mw m, interp m (Thunk ∅ <$> ds) e = Res mw ∧ | ||
213 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
214 | Proof. | ||
215 | apply interp_proper. | ||
216 | by rewrite subst_env_empty subst_env_alt map_fmap_thunk_to_expr_Thunk. | ||
217 | Qed. | ||
218 | |||
219 | Lemma interp_step e1 e2 n mv : | ||
220 | e1 --> e2 → | ||
221 | interp n ∅ e2 = Res mv → | ||
222 | ∃ mw m, interp m ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw. | ||
223 | Proof. | ||
224 | intros Hstep. revert mv n. | ||
225 | induction Hstep; intros mv n Hinterp. | ||
226 | - apply interp_subst_abs in Hinterp as (mw & [|m] & Hinterp & Hv); | ||
227 | simplify_eq/=; [|done..]. | ||
228 | exists mw, (S (S (S m))). rewrite !interp_S /= -!interp_S. | ||
229 | eauto using interp_le with lia. | ||
230 | - exists mv, (S n). rewrite !interp_S /=. | ||
231 | rewrite lookup_empty left_id_L /=. done. | ||
232 | - apply interp_subst_eval in Hinterp as (mw & [|m] & Hinterp & Hv); | ||
233 | simplify_eq/=; [|done..]. | ||
234 | exists mw, (S (S m)). rewrite !interp_S /= -interp_S. | ||
235 | rewrite left_id_L H /=. done. | ||
236 | - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
237 | destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
238 | apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res. | ||
239 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
240 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
241 | destruct (maybe VString _) eqn:Hstring; simplify_res; last first. | ||
242 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
243 | by assert (maybe VString w' = None) as -> by (by destruct v', w'). } | ||
244 | destruct v', w'; simplify_eq/=. | ||
245 | eexists (Some (VClo _ _ _)), (S m1). rewrite !interp_S /=. | ||
246 | rewrite (interp_le Hinterp1) /=; last lia. done. | ||
247 | - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
248 | destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
249 | apply IHHstep in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res. | ||
250 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
251 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
252 | destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first. | ||
253 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
254 | by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). } | ||
255 | destruct v', w'; simplify_eq/=. | ||
256 | eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & Hv); | ||
257 | last apply subst_env_insert_eq; try done. | ||
258 | exists mw, (S (m1 `max` m2)). rewrite !interp_S /=. | ||
259 | rewrite (interp_le Hinterp1) /=; last lia. | ||
260 | by rewrite (interp_le Hinterp2) /=; last lia. | ||
261 | - destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
262 | destruct (interp n _ e1') as [mv1|] eqn:Hinterp1; simplify_eq/=. | ||
263 | apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1). | ||
264 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
265 | { exists None, (S m). by rewrite interp_S /= Hinterp1. } | ||
266 | destruct (maybe VString _) eqn:Hstring; simplify_res; last first. | ||
267 | { exists None, (S m). rewrite interp_S /= Hinterp1 /=. | ||
268 | by assert (maybe VString w1 = None) as -> by (by destruct v1, w1). } | ||
269 | destruct v1, w1; simplify_eq/=. | ||
270 | exists mv, (S (n `max` m)). split; [|done]. rewrite interp_S /=. | ||
271 | rewrite (interp_le Hinterp1) /=; last lia. | ||
272 | destruct (parse _); simplify_res; eauto using interp_le with lia. | ||
273 | Qed. | ||
274 | |||
275 | Lemma final_interp e : | ||
276 | final e → | ||
277 | ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w. | ||
278 | Proof. | ||
279 | induction e as [| | |[]|]; inv 1. | ||
280 | - eexists (VString _), 1. by rewrite interp_S /=. | ||
281 | - eexists (VClo _ _ _), 2. rewrite interp_S /=. split; [done|]. | ||
282 | by rewrite subst_env_empty. | ||
283 | Qed. | ||
284 | |||
285 | Lemma red_final_interp e : | ||
286 | red step e ∨ final e ∨ ∃ m, interp m ∅ e = mfail. | ||
287 | Proof. | ||
288 | induction e. | ||
289 | - (* ENat *) right; left. constructor. | ||
290 | - (* EId *) destruct ds as [e|]. | ||
291 | + left. by repeat econstructor. | ||
292 | + do 2 right. by exists 1. | ||
293 | - (* EEval *) destruct IHe as [[??]|[Hfinal|[m Hinterp]]]. | ||
294 | + left. by repeat econstructor. | ||
295 | + apply final_interp in Hfinal as (w & m & Hinterp & ->). | ||
296 | destruct (maybe VString w) as [x|] eqn:Hw; last first. | ||
297 | { do 2 right. exists (S m). rewrite interp_S /= Hinterp /=. | ||
298 | by rewrite Hw. } | ||
299 | destruct w; simplify_eq/=. | ||
300 | destruct (parse x) as [e|] eqn:Hparse; last first. | ||
301 | { do 2 right. exists (S m). rewrite interp_S /= Hinterp /=. | ||
302 | by rewrite Hparse. } | ||
303 | left. by repeat econstructor. | ||
304 | + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done. | ||
305 | - (* EAbs *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]]. | ||
306 | + left. by repeat econstructor. | ||
307 | + apply final_interp in Hfinal as (w & m & Hinterp & ->). | ||
308 | destruct (maybe VString w) as [x|] eqn:Hw; last first. | ||
309 | { do 2 right. exists (S m). rewrite interp_S /= Hinterp /=. | ||
310 | by rewrite Hw. } | ||
311 | destruct w; naive_solver. | ||
312 | + do 2 right. exists (S m). rewrite interp_S /= Hinterp. done. | ||
313 | - (* EApp *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]]. | ||
314 | + left. by repeat econstructor. | ||
315 | + apply final_interp in Hfinal as (w & m & Hinterp & ->). | ||
316 | destruct (maybe3 VClo w) eqn:Hw. | ||
317 | { destruct w; simplify_eq/=. left. by repeat econstructor. } | ||
318 | do 2 right. exists (S m). by rewrite interp_S /= Hinterp /= Hw. | ||
319 | + do 2 right. exists (S m). by rewrite interp_S /= Hinterp. | ||
320 | Qed. | ||
321 | |||
322 | Lemma interp_complete e1 e2 : | ||
323 | e1 -->* e2 → | ||
324 | nf step e2 → | ||
325 | ∃ mw m, interp m ∅ e1 = Res mw ∧ | ||
326 | if mw is Some w then e2 = val_to_expr w else ¬final e2. | ||
327 | Proof. | ||
328 | intros Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH]. | ||
329 | { destruct (red_final_interp e) as [?|[Hfinal|[m Hinterp]]]; [done|..]. | ||
330 | - apply final_interp in Hfinal as (w & m & ? & ?). | ||
331 | by exists (Some w), m. | ||
332 | - exists None, m. split; [done|]. intros Hfinal. | ||
333 | apply final_interp in Hfinal as (w & m' & ? & _). | ||
334 | by assert (mfail = mret w) by eauto using interp_agree. } | ||
335 | destruct IH as (mw & m & Hinterp & ?); try done. | ||
336 | eapply interp_step in Hinterp as (mw' & m' & ? & ?); last done. | ||
337 | destruct mw, mw'; naive_solver. | ||
338 | Qed. | ||
339 | |||
340 | Lemma interp_complete_ret e1 e2 : | ||
341 | e1 -->* e2 → final e2 → | ||
342 | ∃ w m, interp m ∅ e1 = mret w ∧ e2 = val_to_expr w. | ||
343 | Proof. | ||
344 | intros Hsteps Hfinal. apply interp_complete in Hsteps | ||
345 | as ([w|] & m & ? & ?); naive_solver eauto using final_nf. | ||
346 | Qed. | ||
347 | Lemma interp_complete_fail e1 e2 : | ||
348 | e1 -->* e2 → nf step e2 → ¬final e2 → | ||
349 | ∃ m, interp m ∅ e1 = mfail. | ||
350 | Proof. | ||
351 | intros Hsteps Hnf Hforce. | ||
352 | apply interp_complete in Hsteps as ([w|] & m & ? & ?); simplify_eq/=; try by eauto. | ||
353 | destruct Hforce. apply final_val_to_expr. | ||
354 | Qed. | ||
355 | |||
356 | Lemma interp_sound_open E e n mv : | ||
357 | interp n E e = Res mv → | ||
358 | ∃ e', subst_env E e -->* e' ∧ | ||
359 | if mv is Some v then e' = val_to_expr v else stuck e'. | ||
360 | Proof. | ||
361 | revert E e mv. | ||
362 | induction n as [|n IH]; intros E e mv Hinterp; first done. | ||
363 | rewrite subst_env_eq. rewrite interp_S in Hinterp. | ||
364 | destruct e; simplify_res. | ||
365 | - (* EString *) by eexists. | ||
366 | - (* EId *) | ||
367 | assert (thunk_to_expr <$> (E !! x) ∪ (Thunk ∅ <$> ds) | ||
368 | = (thunk_to_expr <$> E !! x) ∪ ds). | ||
369 | { destruct (_ !! _), ds; f_equal/=. by rewrite subst_env_empty. } | ||
370 | destruct (_ ∪ (_ <$> _)) as [[E1 e1]|], (_ ∪ _) as [e2|]; simplify_res. | ||
371 | * apply IH in Hinterp as (e'' & Hsteps & He''). | ||
372 | exists e''; split; [|done]. | ||
373 | eapply rtc_l; [|done]. by econstructor. | ||
374 | * eexists; split; [done|]. split; [|inv 1]. | ||
375 | intros [? Hstep]. inv_step; simplify_eq/=; congruence. | ||
376 | - (* EEval *) | ||
377 | destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res. | ||
378 | apply IH in Hinterp1 as (e1' & Hsteps1 & He1'). | ||
379 | destruct mv1 as [v1|]; simplify_res; last first. | ||
380 | { eexists; split; [by eapply SEval_rtc|]. split; [|inv 1]. | ||
381 | intros [??]. destruct He1' as [Hnf []]. | ||
382 | inv_step; simpl; eauto. destruct Hnf; eauto. } | ||
383 | destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first. | ||
384 | { eexists; split; [by eapply SEval_rtc|]. split; [|inv 1]. | ||
385 | intros [??]. destruct v1; inv_step. } | ||
386 | destruct v1; simplify_eq/=. | ||
387 | destruct (parse x) as [ex|] eqn:Hparse; simplify_res; last first. | ||
388 | { eexists; split; [by eapply SEval_rtc|]. | ||
389 | split; [|inv 1]. intros [??]. inv_step. } | ||
390 | apply IH in Hinterp as (e'' & Hsteps & He''). | ||
391 | exists e''; split; [|done]. etrans; [by eapply SEval_rtc|]. | ||
392 | eapply rtc_l; [by econstructor|]. | ||
393 | by rewrite subst_env_alt map_fmap_union | ||
394 | map_fmap_thunk_to_expr_Thunk in Hsteps. | ||
395 | - (* EAbs *) | ||
396 | destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res. | ||
397 | apply IH in Hinterp1 as (e1' & Hsteps1 & He1'). | ||
398 | destruct mv1 as [v1|]; simplify_res; last first. | ||
399 | { eexists; split; [by eapply SAbsL_rtc|]. split. | ||
400 | + intros [??]. destruct He1' as [Hnf []]. | ||
401 | inv_step; simpl; eauto. destruct Hnf; eauto. | ||
402 | + intros ?. destruct He1' as [_ []]. by destruct e1'. } | ||
403 | eexists; split; [by eapply SAbsL_rtc|]. | ||
404 | destruct (maybe VString _) as [x|] eqn:Hv1; simplify_res; last first. | ||
405 | { split; [|destruct v1; inv 1]. intros [??]. destruct v1; inv_step. } | ||
406 | by destruct v1; simplify_eq/=. | ||
407 | - (* EApp *) destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
408 | apply IH in Hinterp' as (e' & Hsteps & He'); try done. | ||
409 | destruct mv' as [v'|]; simplify_res; last first. | ||
410 | { eexists; repeat split; [by apply SAppL_rtc| |inv 1]. | ||
411 | intros [e'' Hstep]. destruct He' as [Hnf Hfinal]. | ||
412 | inv Hstep; [by destruct Hfinal; constructor|]. destruct Hnf. eauto. } | ||
413 | destruct (maybe3 VClo v') eqn:?; simplify_res; last first. | ||
414 | { eexists; repeat split; [by apply SAppL_rtc| |inv 1]. | ||
415 | intros [e'' Hstep]. inv Hstep; destruct v'; by repeat inv_step. } | ||
416 | destruct v'; simplify_res. | ||
417 | apply IH in Hinterp as (e'' & Hsteps' & He''). | ||
418 | eexists; split; [|done]. etrans; [by apply SAppL_rtc|]. | ||
419 | eapply rtc_l; first by constructor. | ||
420 | rewrite subst_env_insert // in Hsteps'. | ||
421 | Qed. | ||
422 | |||
423 | Lemma interp_sound n e mv : | ||
424 | interp n ∅ e = Res mv → | ||
425 | ∃ e', e -->* e' ∧ if mv is Some v then e' = val_to_expr v else stuck e'. | ||
426 | Proof. | ||
427 | intros Hsteps%interp_sound_open; try done. | ||
428 | by rewrite subst_env_empty in Hsteps. | ||
429 | Qed. | ||
430 | |||
431 | (** Final theorems *) | ||
432 | Theorem interp_sound_complete_ret e v : | ||
433 | (∃ w n, interp n ∅ e = mret w ∧ val_to_expr v = val_to_expr w) | ||
434 | ↔ e -->* val_to_expr v. | ||
435 | Proof. | ||
436 | split. | ||
437 | - by intros (n & w & (e' & ? & ->)%interp_sound & ->). | ||
438 | - intros Hsteps. apply interp_complete in Hsteps as ([] & ? & ? & ?); | ||
439 | unfold nf, red; | ||
440 | naive_solver eauto using final_val_to_expr, step_not_val_to_expr. | ||
441 | Qed. | ||
442 | |||
443 | Theorem interp_sound_complete_ret_string e s : | ||
444 | (∃ n, interp n ∅ e = mret (VString s)) ↔ e -->* EString s. | ||
445 | Proof. | ||
446 | split. | ||
447 | - by intros [n (e' & ? & ->)%interp_sound]. | ||
448 | - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?); | ||
449 | simplify_eq/=; eauto. | ||
450 | Qed. | ||
451 | |||
452 | Theorem interp_sound_complete_fail e : | ||
453 | (∃ n, interp n ∅ e = mfail) ↔ ∃ e', e -->* e' ∧ stuck e'. | ||
454 | Proof. | ||
455 | split. | ||
456 | - by intros [n ?%interp_sound]. | ||
457 | - intros (e' & Hsteps & Hnf & Hforced). by eapply interp_complete_fail. | ||
458 | Qed. | ||
459 | |||
460 | Theorem interp_sound_complete_no_fuel e : | ||
461 | (∀ n, interp n ∅ e = NoFuel) ↔ all_loop step e. | ||
462 | Proof. | ||
463 | rewrite all_loop_alt. split. | ||
464 | - intros Hnofuel e' Hsteps. | ||
465 | destruct (red_final_interp e') as [|[|He']]; [done|..]. | ||
466 | + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); last done. | ||
467 | by rewrite Hnofuel in Hinterp. | ||
468 | + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]). | ||
469 | destruct (interp_complete e e'') as (mv & n & Hinterp & _); [by etrans|done|]. | ||
470 | by rewrite Hnofuel in Hinterp. | ||
471 | - intros Hred n. destruct (interp n ∅ e) as [mv|] eqn:Hinterp; [|done]. | ||
472 | apply interp_sound in Hinterp as (e' & Hsteps%Hred & Hstuck). | ||
473 | destruct mv as [v|]; simplify_eq/=. | ||
474 | + apply final_nf in Hsteps as []. apply final_val_to_expr. | ||
475 | + by destruct Hstuck as [[] ?]. | ||
476 | Qed. | ||
477 | |||
478 | End evallang. | ||
diff --git a/theories/evallang/operational.v b/theories/evallang/operational.v new file mode 100644 index 0000000..79174dd --- /dev/null +++ b/theories/evallang/operational.v | |||
@@ -0,0 +1,140 @@ | |||
1 | From Coq Require Import Ascii. | ||
2 | From mininix Require Export utils. | ||
3 | From stdpp Require Import options. | ||
4 | |||
5 | Module Import evallang. | ||
6 | |||
7 | Inductive expr := | ||
8 | | EString (s : string) | ||
9 | | EId (ds : option expr) (x : string) | ||
10 | | EEval (ds : gmap string expr) (ee : expr) | ||
11 | | EAbs (ex e : expr) | ||
12 | | EApp (e1 e2 : expr). | ||
13 | |||
14 | Module parser. | ||
15 | Inductive token := | ||
16 | | TId (s : string) | ||
17 | | TString (s : string) | ||
18 | | TColon | ||
19 | | TExclamation | ||
20 | | TParenL | ||
21 | | TParenR. | ||
22 | |||
23 | Inductive token_state := | ||
24 | TSString (s : string) | TSId (s : string) | TSOther. | ||
25 | |||
26 | Definition token_state_push (st : token_state) (k : list token) : list token := | ||
27 | match st with | ||
28 | | TSId s => TId (String.rev s) :: k | ||
29 | | _ => k | ||
30 | end. | ||
31 | |||
32 | Fixpoint tokenize_go (sin : string) (st : token_state) | ||
33 | (k : list token) : option (list token) := | ||
34 | match sin, st with | ||
35 | | "", TSString _ => None (* no closing "" *) | ||
36 | | "", _ => Some (reverse (token_state_push st k)) | ||
37 | | String "\" (String """" sin), TSString s => | ||
38 | tokenize_go sin (TSString (String """" s)) k | ||
39 | | String """" sin, TSString s => | ||
40 | tokenize_go sin TSOther (TString (String.rev s) :: k) | ||
41 | | String a sin, TSString s => tokenize_go sin (TSString (String a s)) k | ||
42 | | String ":" sin, _ => tokenize_go sin TSOther (TColon :: token_state_push st k) | ||
43 | | String "!" sin, _ => tokenize_go sin TSOther (TExclamation :: token_state_push st k) | ||
44 | | String "(" sin, _ => tokenize_go sin TSOther (TParenL :: token_state_push st k) | ||
45 | | String ")" sin, _ => tokenize_go sin TSOther (TParenR :: token_state_push st k) | ||
46 | | String """" sin, _ => tokenize_go sin (TSString "") k | ||
47 | | String a sin, TSOther => | ||
48 | if Ascii.is_space a then tokenize_go sin TSOther k | ||
49 | else tokenize_go sin (TSId (String a EmptyString)) k | ||
50 | | String a sin, TSId s => | ||
51 | if Ascii.is_space a then tokenize_go sin TSOther (TId (String.rev s) :: k) | ||
52 | else tokenize_go sin (TSId (String a s)) k | ||
53 | end. | ||
54 | Definition tokenize (sin : string) : option (list token) := | ||
55 | tokenize_go sin TSOther []. | ||
56 | |||
57 | Inductive stack_item := | ||
58 | | SExpr (e : expr) | ||
59 | | SAbsR (e : expr) | ||
60 | | SEval | ||
61 | | SParenL. | ||
62 | |||
63 | Definition stack_push (e : expr) (k : list stack_item) : list stack_item := | ||
64 | match k with | ||
65 | | SExpr e1 :: k => SExpr (EApp e1 e) :: k | ||
66 | | SEval :: k => SExpr (EEval ∅ e) :: k | ||
67 | | _ => SExpr e :: k | ||
68 | end. | ||
69 | |||
70 | Fixpoint stack_pop_go (e : expr) | ||
71 | (k : list stack_item) : option (expr * list stack_item) := | ||
72 | match k with | ||
73 | | SAbsR e1 :: k => stack_pop_go (EAbs e1 e) k | ||
74 | | _ => Some (e, k) | ||
75 | end. | ||
76 | |||
77 | Definition stack_pop (k : list stack_item) : option (expr * list stack_item) := | ||
78 | match k with | ||
79 | | SExpr e :: k => stack_pop_go e k | ||
80 | | _ => None | ||
81 | end. | ||
82 | |||
83 | Fixpoint parse_go (ts : list token) (k : list stack_item) : option expr := | ||
84 | match ts with | ||
85 | | [] => '(e, k) ← stack_pop k; guard (k = []);; Some e | ||
86 | | TString x :: ts => parse_go ts (stack_push (EString x) k) | ||
87 | | TId "eval" :: TExclamation :: ts => parse_go ts (SEval :: k) | ||
88 | | TId x :: TColon :: ts => parse_go ts (SAbsR (EString x) :: k) | ||
89 | | TId x :: ts => parse_go ts (stack_push (EId None x) k) | ||
90 | | TColon :: ts => | ||
91 | '(e, k) ← stack_pop k; | ||
92 | parse_go ts (SAbsR e :: k) | ||
93 | | TParenL :: ts => parse_go ts (SParenL :: k) | ||
94 | | TParenR :: ts => | ||
95 | '(e, k) ← stack_pop k; | ||
96 | match k with | ||
97 | | SParenL :: k => parse_go ts (stack_push e k) | ||
98 | | _ => None | ||
99 | end | ||
100 | | _ => None | ||
101 | end. | ||
102 | |||
103 | Definition parse (sin : string) : option expr := | ||
104 | ts ← tokenize sin; parse_go ts []. | ||
105 | End parser. | ||
106 | |||
107 | Definition parse := parser.parse. | ||
108 | |||
109 | Fixpoint subst (ds : gmap string expr) (e : expr) : expr := | ||
110 | match e with | ||
111 | | EString s => EString s | ||
112 | | EId ds' x => EId (ds !! x ∪ ds') x | ||
113 | | EEval ds' ee => EEval (ds ∪ ds') (subst ds ee) | ||
114 | | EAbs ex e => EAbs (subst ds ex) (subst ds e) | ||
115 | | EApp e1 e2 => EApp (subst ds e1) (subst ds e2) | ||
116 | end. | ||
117 | |||
118 | Reserved Infix "-->" (right associativity, at level 55). | ||
119 | Inductive step : expr → expr → Prop := | ||
120 | | Sβ x e1 e2 : EApp (EAbs (EString x) e1) e2 --> subst {[x:=e2]} e1 | ||
121 | | SId e x : EId (Some e) x --> e | ||
122 | | SEvalString ds s e : parse s = Some e → EEval ds (EString s) --> subst ds e | ||
123 | | SAbsL ex1 ex1' e : ex1 --> ex1' → EAbs ex1 e --> EAbs ex1' e | ||
124 | | SAppL e1 e1' e2 : e1 --> e1' → EApp e1 e2 --> EApp e1' e2 | ||
125 | | SEval ds e1 e1' : e1 --> e1' → EEval ds e1 --> EEval ds e1' | ||
126 | where "e1 --> e2" := (step e1 e2). | ||
127 | |||
128 | Infix "-->*" := (rtc step) (right associativity, at level 55). | ||
129 | |||
130 | Definition final (e : expr) : Prop := | ||
131 | match e with | ||
132 | | EString _ => True | ||
133 | | EAbs (EString _) _ => True | ||
134 | | _ => False | ||
135 | end. | ||
136 | |||
137 | Definition stuck (e : expr) : Prop := | ||
138 | nf step e ∧ ¬final e. | ||
139 | |||
140 | End evallang. | ||
diff --git a/theories/evallang/operational_props.v b/theories/evallang/operational_props.v new file mode 100644 index 0000000..31724c0 --- /dev/null +++ b/theories/evallang/operational_props.v | |||
@@ -0,0 +1,33 @@ | |||
1 | From mininix Require Export evallang.operational. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import evallang. | ||
5 | Export evallang. | ||
6 | |||
7 | (** Properties of operational semantics *) | ||
8 | Lemma step_not_final e1 e2 : e1 --> e2 → ¬final e1. | ||
9 | Proof. induction 1; simpl; repeat case_match; naive_solver. Qed. | ||
10 | Lemma final_nf e : final e → nf step e. | ||
11 | Proof. by intros ? [??%step_not_final]. Qed. | ||
12 | |||
13 | Lemma SAbsL_rtc ex1 ex1' e : ex1 -->* ex1' → EAbs ex1 e -->* EAbs ex1' e. | ||
14 | Proof. induction 1; econstructor; eauto using step. Qed. | ||
15 | Lemma SAppL_rtc e1 e1' e2 : e1 -->* e1' → EApp e1 e2 -->* EApp e1' e2. | ||
16 | Proof. induction 1; econstructor; eauto using step. Qed. | ||
17 | Lemma SEval_rtc ds e1 e1' : e1 -->* e1' → EEval ds e1 -->* EEval ds e1'. | ||
18 | Proof. induction 1; econstructor; eauto using step. Qed. | ||
19 | |||
20 | Ltac inv_step := repeat | ||
21 | match goal with H : ?e --> _ |- _ => assert_fails (is_var e); inv H end. | ||
22 | |||
23 | Lemma step_det e d1 d2 : | ||
24 | e --> d1 → | ||
25 | e --> d2 → | ||
26 | d1 = d2. | ||
27 | Proof. | ||
28 | intros Hred1. revert d2. | ||
29 | induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step; | ||
30 | f_equal; by apply IHHred1. | ||
31 | Qed. | ||
32 | |||
33 | End evallang. | ||
diff --git a/theories/evallang/tests.v b/theories/evallang/tests.v new file mode 100644 index 0000000..eaba8a0 --- /dev/null +++ b/theories/evallang/tests.v | |||
@@ -0,0 +1,33 @@ | |||
1 | From mininix Require Export evallang.interp. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Import evallang. | ||
5 | |||
6 | Definition interp' (n : nat) (s : string) : res val := | ||
7 | interp n ∅ (EEval ∅ (EString s)). | ||
8 | |||
9 | Lemma test_1_a : interp' 1000 ("(x: x) ""s""") = mret (VString "s"). | ||
10 | Proof. by vm_compute. Qed. | ||
11 | Lemma test_1_b : interp' 1000 ("(""x"": x) ""s""") = mret (VString "s"). | ||
12 | Proof. by vm_compute. Qed. | ||
13 | Lemma test_1_c : interp' 1000 ("((y:y) ""x"": x) ""s""") = mret (VString "s"). | ||
14 | Proof. by vm_compute. Qed. | ||
15 | Lemma test_1_d : interp' 1000 ("(((y:y) ""x""): x) ""s""") = mret (VString "s"). | ||
16 | Proof. by vm_compute. Qed. | ||
17 | |||
18 | Lemma test_2 : interp' 1000 ("(x: y: eval! y) ""s"" ""x""") = mret (VString "s"). | ||
19 | Proof. by vm_compute. Qed. | ||
20 | |||
21 | Lemma test_3 : interp' 1000 ("eval! ""x: x"" ""s""") = mret (VString "s"). | ||
22 | Proof. by vm_compute. Qed. | ||
23 | |||
24 | Lemma test_4_a : | ||
25 | interp' 1000 ("(x: y: eval! y) ""s"" ""x""") = mret (VString "s"). | ||
26 | Proof. by vm_compute. Qed. | ||
27 | Lemma test_4_b : | ||
28 | interp' 1000 ("eval! ""(x: y: eval! y) \""s\"" \""x\""""") = mret (VString "s"). | ||
29 | Proof. by vm_compute. Qed. | ||
30 | |||
31 | Lemma test_5 : | ||
32 | interp' 1000 ("(x: y: eval! ""x: x"" (eval! y)) ""s"" ""x""") = mret (VString "s"). | ||
33 | Proof. by vm_compute. Qed. | ||
diff --git a/theories/lambda/interp.v b/theories/lambda/interp.v new file mode 100644 index 0000000..5bc60d1 --- /dev/null +++ b/theories/lambda/interp.v | |||
@@ -0,0 +1,44 @@ | |||
1 | From mininix Require Export res lambda.operational_props. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import lambda. | ||
5 | Export lambda. | ||
6 | |||
7 | Inductive thunk := | ||
8 | Thunk { thunk_env : gmap string thunk; thunk_expr : expr }. | ||
9 | Add Printing Constructor thunk. | ||
10 | Notation env := (gmap string thunk). | ||
11 | |||
12 | Inductive val := | ||
13 | | VString (s : string) | ||
14 | | VClo (x : string) (E : env) (e : expr). | ||
15 | |||
16 | Global Instance maybe_VClo : Maybe3 VClo := λ v, | ||
17 | if v is VClo x E e then Some (x, E, e) else None. | ||
18 | |||
19 | Definition interp1 (interp : env → expr → res val) (E : env) (e : expr) : res val := | ||
20 | match e with | ||
21 | | EString s => | ||
22 | mret (VString s) | ||
23 | | EId x => | ||
24 | t ← Res (E !! x); | ||
25 | interp (thunk_env t) (thunk_expr t) | ||
26 | | EAbs x e => | ||
27 | mret (VClo x E e) | ||
28 | | EApp e1 e2 => | ||
29 | v1 ← interp E e1; | ||
30 | '(x, E', e') ← Res (maybe3 VClo v1); | ||
31 | interp (<[x:=Thunk E e2]> E') e' | ||
32 | end. | ||
33 | |||
34 | Fixpoint interp (n : nat) (E : env) (e : expr) : res val := | ||
35 | match n with | ||
36 | | O => NoFuel | ||
37 | | S n => interp1 (interp n) E e | ||
38 | end. | ||
39 | |||
40 | Global Opaque interp. | ||
41 | |||
42 | End lambda. | ||
43 | |||
44 | Add Printing Constructor lambda.thunk. | ||
diff --git a/theories/lambda/interp_proofs.v b/theories/lambda/interp_proofs.v new file mode 100644 index 0000000..efd0982 --- /dev/null +++ b/theories/lambda/interp_proofs.v | |||
@@ -0,0 +1,614 @@ | |||
1 | From mininix Require Export lambda.interp. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import lambda. | ||
5 | Export lambda. | ||
6 | |||
7 | Lemma interp_S n : interp (S n) = interp1 (interp n). | ||
8 | Proof. done. Qed. | ||
9 | |||
10 | Fixpoint thunk_size (t : thunk) : nat := | ||
11 | S (map_sum_with thunk_size (thunk_env t)). | ||
12 | Definition env_size (E : env) : nat := | ||
13 | map_sum_with thunk_size E. | ||
14 | |||
15 | Lemma env_ind (P : env → Prop) : | ||
16 | (∀ E, map_Forall (λ i, P ∘ thunk_env) E → P E) → | ||
17 | ∀ E : env, P E. | ||
18 | Proof. | ||
19 | intros Pbs E. | ||
20 | induction (Nat.lt_wf_0_projected env_size E) as [E _ IH]. | ||
21 | apply Pbs, map_Forall_lookup=> y [E' e'] Hy. | ||
22 | apply (map_sum_with_lookup_le thunk_size) in Hy. | ||
23 | apply IH. by rewrite -Nat.le_succ_l. | ||
24 | Qed. | ||
25 | |||
26 | (** Correspondence to operational semantics *) | ||
27 | Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr := | ||
28 | subst (thunk_to_expr <$> E). | ||
29 | Fixpoint thunk_to_expr (t : thunk) : expr := | ||
30 | subst_env' thunk_to_expr (thunk_env t) (thunk_expr t). | ||
31 | Notation subst_env := (subst_env' thunk_to_expr). | ||
32 | |||
33 | Lemma subst_env_eq e E : | ||
34 | subst_env E e = | ||
35 | match e with | ||
36 | | EString s => EString s | ||
37 | | EId x => if E !! x is Some t then thunk_to_expr t else EId x | ||
38 | | EAbs x e => EAbs x (subst_env (delete x E) e) | ||
39 | | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2) | ||
40 | end. | ||
41 | Proof. | ||
42 | rewrite /subst_env. destruct e; simpl; try done. | ||
43 | - rewrite lookup_fmap. by destruct (E !! x) as [[]|]. | ||
44 | - by rewrite fmap_delete. | ||
45 | Qed. | ||
46 | Lemma subst_env_id x E : | ||
47 | subst_env E (EId x) = if E !! x is Some t then thunk_to_expr t else EId x. | ||
48 | Proof. by rewrite subst_env_eq. Qed. | ||
49 | |||
50 | Lemma subst_env_alt E e : subst_env E e = subst (thunk_to_expr <$> E) e. | ||
51 | Proof. done. Qed. | ||
52 | |||
53 | (* Use the unfolding lemmas, don't rely on conversion *) | ||
54 | Opaque subst_env'. | ||
55 | |||
56 | Definition val_to_expr (v : val) : expr := | ||
57 | match v with | ||
58 | | VString s => EString s | ||
59 | | VClo x E e => EAbs x (subst_env (delete x E) e) | ||
60 | end. | ||
61 | |||
62 | Lemma final_val_to_expr v : final (val_to_expr v). | ||
63 | Proof. by destruct v. Qed. | ||
64 | Lemma step_not_val_to_expr v e : val_to_expr v --> e → False. | ||
65 | Proof. intros []%step_not_final. apply final_val_to_expr. Qed. | ||
66 | |||
67 | Lemma subst_empty e : subst ∅ e = e. | ||
68 | Proof. induction e; f_equal/=; auto. Qed. | ||
69 | |||
70 | Lemma subst_env_empty e : subst_env ∅ e = e. | ||
71 | Proof. rewrite subst_env_alt. apply subst_empty. Qed. | ||
72 | |||
73 | Lemma interp_le {n1 n2 E e mv} : | ||
74 | interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv. | ||
75 | Proof. | ||
76 | revert n2 E e mv. | ||
77 | induction n1 as [|n1 IH]; intros [|n2] E e mv He ?; [by (done || lia)..|]. | ||
78 | rewrite interp_S in He; rewrite interp_S; destruct e; | ||
79 | repeat match goal with | ||
80 | | _ => case_match | ||
81 | | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res | ||
82 | | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res | ||
83 | | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res | ||
84 | | |- interp ?n ?E ?e ≫= _ = _ => erewrite (IH n E e) by (done || lia) | ||
85 | | _ => progress simplify_res | ||
86 | | _ => progress simplify_option_eq | ||
87 | end; eauto with lia. | ||
88 | Qed. | ||
89 | |||
90 | Lemma interp_agree {n1 n2 E e mv1 mv2} : | ||
91 | interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2. | ||
92 | Proof. | ||
93 | intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2). | ||
94 | - rewrite -He2. symmetry. eauto using interp_le. | ||
95 | - rewrite -He1. eauto using interp_le. | ||
96 | Qed. | ||
97 | |||
98 | Definition is_not_id (e : expr) : Prop := | ||
99 | match e with EId _ => False | _ => True end. | ||
100 | |||
101 | Lemma id_or_not e : (∃ x, e = EId x) ∨ is_not_id e. | ||
102 | Proof. destruct e; naive_solver. Qed. | ||
103 | |||
104 | Lemma interp_not_id n E e v : | ||
105 | interp n E e = mret v → is_not_id (subst_env E e). | ||
106 | Proof. | ||
107 | revert E e v. induction n as [|n IH]; intros E e v; [done|]. | ||
108 | rewrite interp_S. destruct e; simpl; try done. | ||
109 | rewrite subst_env_id. destruct (_ !! _) as [[[]]|]; naive_solver. | ||
110 | Qed. | ||
111 | |||
112 | Fixpoint closed (X : stringset) (e : expr) : Prop := | ||
113 | match e with | ||
114 | | EString _ => True | ||
115 | | EId x => x ∈ X | ||
116 | | EAbs x e => closed ({[ x ]} ∪ X) e | ||
117 | | EApp e1 e2 => closed X e1 ∧ closed X e2 | ||
118 | end. | ||
119 | |||
120 | Inductive closed_thunk (t : thunk) : Prop := { | ||
121 | closed_thunk_env : map_Forall (λ _, closed_thunk) (thunk_env t); | ||
122 | closed_thunk_expr : closed (dom (thunk_env t)) (thunk_expr t); | ||
123 | }. | ||
124 | Notation closed_env := (map_Forall (M:=env) (λ _, closed_thunk)). | ||
125 | |||
126 | Definition closed_val (v : val) : Prop := | ||
127 | match v with | ||
128 | | VString _ => True | ||
129 | | VClo x E e => closed_env E ∧ closed ({[x]} ∪ dom E) e | ||
130 | end. | ||
131 | |||
132 | Lemma closed_thunk_eq E e : | ||
133 | closed_thunk (Thunk E e) ↔ closed_env E ∧ closed (dom E) e. | ||
134 | Proof. split; inv 1; constructor; done. Qed. | ||
135 | |||
136 | Lemma closed_env_delete x E : closed_env E → closed_env (delete x E). | ||
137 | Proof. apply map_Forall_delete. Qed. | ||
138 | |||
139 | Lemma closed_env_insert x t E : | ||
140 | closed_thunk t → closed_env E → closed_env (<[x:=t]> E). | ||
141 | Proof. apply: map_Forall_insert_2. Qed. | ||
142 | |||
143 | Lemma closed_env_lookup E x t : | ||
144 | closed_env E → E !! x = Some t → closed_thunk t. | ||
145 | Proof. apply map_Forall_lookup_1. Qed. | ||
146 | |||
147 | Lemma closed_subst E ds e : | ||
148 | dom ds ## E → closed E e → subst ds e = e. | ||
149 | Proof. | ||
150 | revert E ds. | ||
151 | induction e; intros E ds Hdisj Heclosed; simplify_eq/=; first done. | ||
152 | - assert (Hxds : x ∉ dom ds) by set_solver. | ||
153 | by rewrite (not_elem_of_dom_1 _ _ Hxds). | ||
154 | - f_equal. by apply IHe with (E := {[x]} ∪ E); first set_solver. | ||
155 | - f_equal; naive_solver. | ||
156 | Qed. | ||
157 | |||
158 | Lemma closed_weaken X Y e : closed X e → X ⊆ Y → closed Y e. | ||
159 | Proof. revert X Y; induction e; naive_solver eauto with set_solver. Qed. | ||
160 | |||
161 | Lemma subst_closed ds X e : | ||
162 | map_Forall (λ _, closed ∅) ds → | ||
163 | closed (dom ds ∪ X) e → | ||
164 | closed X (subst ds e). | ||
165 | Proof. | ||
166 | revert X ds. induction e; intros X ds; repeat (case_decide || simplify_eq/=). | ||
167 | - done. | ||
168 | - intros. case_match. | ||
169 | + apply H in H1. by eapply closed_weaken. | ||
170 | + apply not_elem_of_dom in H1. set_solver. | ||
171 | - intros. apply IHe. | ||
172 | + by apply map_Forall_delete. | ||
173 | + by rewrite dom_delete_L assoc_L difference_union_L | ||
174 | [dom _ ∪ _]comm_L -assoc_L. | ||
175 | - naive_solver. | ||
176 | Qed. | ||
177 | |||
178 | Lemma subst_env_delete_closed E X e x : | ||
179 | closed_env E → | ||
180 | closed ({[x]} ∪ X) (subst_env E e) → | ||
181 | closed ({[x]} ∪ X) (subst_env (delete x E) e). | ||
182 | Proof. | ||
183 | revert E X x. | ||
184 | induction e as [s | z | z e IHe | e1 IHe1 e2 IHe2]; intros E X x. | ||
185 | - rewrite !subst_env_eq //. | ||
186 | - rewrite !subst_env_eq /=. case_match. | ||
187 | + destruct (decide (x = z)) as [->|?]. | ||
188 | * rewrite lookup_delete. set_solver. | ||
189 | * rewrite lookup_delete_ne // H //. | ||
190 | + destruct (decide (x = z)) as [->|?]. | ||
191 | * rewrite delete_notin // H //. | ||
192 | * rewrite lookup_delete_ne // H //. | ||
193 | - intros HE. | ||
194 | rewrite [subst_env (delete _ _) _]subst_env_eq subst_env_eq /= | ||
195 | delete_commute comm_L -assoc_L. | ||
196 | by apply IHe, map_Forall_delete. | ||
197 | - rewrite [subst_env (delete _ _) _]subst_env_eq subst_env_eq /=. | ||
198 | naive_solver. | ||
199 | Qed. | ||
200 | |||
201 | Lemma subst_env_closed E X e : | ||
202 | closed_env E → closed (dom E ∪ X) e → closed X (subst_env E e). | ||
203 | Proof. | ||
204 | revert e X. induction E using env_ind. | ||
205 | induction e; intros X Hcenv Hclosed; simplify_eq/=. | ||
206 | - done. | ||
207 | - rewrite subst_env_eq. case_match. | ||
208 | + destruct t as [Et et]; simpl. | ||
209 | apply closed_env_lookup in H0 as Htclosed; last done. | ||
210 | apply closed_thunk_eq in Htclosed as [HEtclosed Hetclosed]. | ||
211 | apply (H _ _ H0); simpl. | ||
212 | * exact HEtclosed. | ||
213 | * eapply closed_weaken; set_solver. | ||
214 | + simpl in *. apply not_elem_of_dom in H0. set_solver. | ||
215 | - rewrite subst_env_eq. simpl in *. | ||
216 | rewrite comm_L -assoc_L in Hclosed. | ||
217 | apply IHe in Hclosed; last exact Hcenv. | ||
218 | apply subst_env_delete_closed; first done. | ||
219 | by rewrite comm_L. | ||
220 | - rewrite subst_env_eq. naive_solver. | ||
221 | Qed. | ||
222 | |||
223 | Lemma thunk_to_expr_closed t : closed_thunk t → closed ∅ (thunk_to_expr t). | ||
224 | Proof. | ||
225 | destruct t as [E e]. intros [HEclosed Heclosed]%closed_thunk_eq. | ||
226 | by apply subst_env_closed; last rewrite union_empty_r_L. | ||
227 | Qed. | ||
228 | |||
229 | Lemma subst_env_insert E x e t : | ||
230 | closed_env E → | ||
231 | subst_env (<[x:=t]> E) e | ||
232 | = subst {[x:=thunk_to_expr t]} (subst_env (delete x E) e). | ||
233 | Proof. | ||
234 | revert E. induction e; intros E HEclosed; simpl. | ||
235 | - done. | ||
236 | - destruct (decide (x = x0)) as [->|?]. | ||
237 | + rewrite subst_env_eq lookup_insert subst_env_id | ||
238 | lookup_delete /= lookup_singleton. done. | ||
239 | + rewrite subst_env_eq lookup_insert_ne // subst_env_id. | ||
240 | destruct (E !! x0) eqn:Elookup. | ||
241 | * apply closed_env_lookup in Elookup as Hc0closed; last done. | ||
242 | apply thunk_to_expr_closed in Hc0closed. | ||
243 | rewrite lookup_delete_ne // Elookup. | ||
244 | by erewrite closed_subst with (E := ∅). | ||
245 | * by rewrite lookup_delete_ne // Elookup /= lookup_singleton_ne. | ||
246 | - rewrite (subst_env_eq (EAbs x0 e)) (subst_env_eq (EAbs _ _)) /=. f_equal. | ||
247 | destruct (decide (x0 = x)) as [->|?]. | ||
248 | + by rewrite delete_insert_delete delete_idemp | ||
249 | delete_singleton subst_empty. | ||
250 | + rewrite delete_insert_ne // delete_singleton_ne // delete_commute. | ||
251 | apply IHe. by apply closed_env_delete. | ||
252 | - rewrite (subst_env_eq (EApp _ _)) [subst_env (delete x E) _]subst_env_eq /=. | ||
253 | f_equal; auto. | ||
254 | Qed. | ||
255 | |||
256 | Lemma subst_env_insert_eq e1 e2 E1 E2 x E1' E2' e1' e2' : | ||
257 | closed_env E1 → closed_env E2 → | ||
258 | subst_env (delete x E1) e1 = subst_env (delete x E2) e2 → | ||
259 | subst_env E1' e1' = subst_env E2' e2' → | ||
260 | subst_env (<[x:=Thunk E1' e1']> E1) e1 | ||
261 | = subst_env (<[x:=Thunk E2' e2']> E2) e2. | ||
262 | Proof. | ||
263 | intros HE1closed HE2closed He' He. | ||
264 | rewrite !subst_env_insert //=. by rewrite He' He. | ||
265 | Qed. | ||
266 | |||
267 | Lemma interp_closed n E e mv : | ||
268 | closed_env E → closed (dom E) e → interp n E e = Res mv → | ||
269 | if mv is Some v then closed_val v else True. | ||
270 | Proof. | ||
271 | revert E e mv. | ||
272 | induction n; first done; intros E e mv HEclosed Heclosed Hinterp. | ||
273 | destruct e. | ||
274 | - rewrite interp_S /= in Hinterp. by destruct mv; simplify_res. | ||
275 | - rewrite interp_S /= in Hinterp. simplify_option_eq. | ||
276 | destruct (E !! x) eqn:Hlookup; simplify_res; try done. | ||
277 | apply closed_env_lookup in Hlookup; last assumption. | ||
278 | destruct t as [E' e']. apply closed_thunk_eq in Hlookup as [Henv Hexpr]. | ||
279 | by apply IHn with (E := E') (e := e'). | ||
280 | - rewrite interp_S /= in Hinterp. simplify_option_eq. | ||
281 | destruct mv as [v|]; simplify_res. split_and!. | ||
282 | + set_solver. | ||
283 | + done. | ||
284 | - rewrite interp_S /= in Hinterp. simplify_option_eq. | ||
285 | destruct Heclosed as [He1closed He2closed]. | ||
286 | destruct (interp n E e1) as [[[]|]|] eqn:Einterp; simplify_res; try done. | ||
287 | apply IHn in Einterp; try done. | ||
288 | simpl in Einterp. destruct Einterp as [Hinterp1 Hinterp2]. | ||
289 | apply IHn in Hinterp; first done. | ||
290 | + rewrite <-insert_delete_insert. | ||
291 | apply map_Forall_insert; first apply lookup_delete. split. | ||
292 | * by split. | ||
293 | * by apply closed_env_delete. | ||
294 | + by rewrite dom_insert_L. | ||
295 | Qed. | ||
296 | |||
297 | Lemma interp_proper n E1 E2 e1 e2 mv : | ||
298 | closed_env E1 → closed_env E2 → | ||
299 | closed (dom E1) e1 → closed (dom E2) e2 → | ||
300 | subst_env E1 e1 = subst_env E2 e2 → | ||
301 | interp n E1 e1 = Res mv → | ||
302 | ∃ mw m, interp m E2 e2 = Res mw ∧ | ||
303 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
304 | Proof. | ||
305 | revert n E2 E1 e1 e2 mv. induction n as [|n IHn]; [done|]. | ||
306 | intros E2. induction E2 as [E2 IH] using env_ind. | ||
307 | intros E1 e1 e2 mv HE1closed HE2closed He1closed He2closed Hsubst Hinterp. | ||
308 | destruct (id_or_not e1) as [[x ->]|?]. | ||
309 | { rewrite interp_S /= in Hinterp. | ||
310 | destruct (E1 !! x) as [[E' e']|] eqn:Hx; simplify_eq/=; | ||
311 | last by apply not_elem_of_dom in Hx. | ||
312 | rewrite subst_env_id Hx in Hsubst. | ||
313 | apply closed_env_lookup in Hx; last done. | ||
314 | rewrite closed_thunk_eq in Hx. | ||
315 | destruct Hx as [HE'close He'closed]. | ||
316 | eauto. } | ||
317 | destruct (id_or_not e2) as [[x ->]|?]. | ||
318 | { rewrite subst_env_id in Hsubst. | ||
319 | destruct (E2 !! x) as [[E' e']|] eqn:Hx; simplify_eq/=. | ||
320 | - apply closed_env_lookup in Hx as Hclosed; last done. | ||
321 | rewrite closed_thunk_eq in Hclosed. | ||
322 | destruct Hclosed as [HE'closed He'closed]. | ||
323 | rewrite map_Forall_lookup in IH. | ||
324 | odestruct (IH _ _ Hx) as (w & m & Hinterp' & Hw); | ||
325 | first apply HE1closed; try done. | ||
326 | exists w, (S m). by rewrite interp_S /= Hx /=. | ||
327 | - destruct mv as [v|]. | ||
328 | + apply interp_not_id in Hinterp. by rewrite Hsubst in Hinterp. | ||
329 | + exists None, 1. by rewrite interp_S /= Hx. } | ||
330 | rewrite (subst_env_eq e1) (subst_env_eq e2) in Hsubst. | ||
331 | rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done. | ||
332 | - eexists (Some (VString _)), 1. by rewrite interp_S. | ||
333 | - eexists (Some (VClo _ _ _)), 1. split; first by rewrite interp_S. | ||
334 | by do 2 f_equal/=. | ||
335 | - destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
336 | destruct He1closed as [He1_1closed He1_2closed], | ||
337 | He2closed as [He2_1closed He2_2closed]. | ||
338 | apply interp_closed in Hinterp' as Hclosed; [|done..]. | ||
339 | eapply IHn with (e2 := e2_1) in Hinterp' as (mw' & m1 & Hinterp1 & ?); | ||
340 | try done. | ||
341 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
342 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
343 | destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first. | ||
344 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
345 | by assert (maybe3 VClo w' = None) as -> by (by destruct v', w'). } | ||
346 | destruct v', w'; simplify_eq/=. | ||
347 | eapply IHn with (E2 := <[x0:=Thunk E2 e2_2]> E0) in Hinterp | ||
348 | as (w & m2 & Hinterp2 & ?). | ||
349 | + exists w, (S (m1 `max` m2)). rewrite interp_S /=. | ||
350 | rewrite (interp_le Hinterp1) /=; last lia. | ||
351 | rewrite (interp_le Hinterp2) /=; last lia. done. | ||
352 | + rewrite -insert_delete_insert. | ||
353 | apply map_Forall_insert; first apply lookup_delete. | ||
354 | split; first done. apply closed_env_delete. naive_solver. | ||
355 | + apply interp_closed in Hinterp1; [|done..]. | ||
356 | rewrite /closed_val in Hinterp1. destruct Hinterp1 as [??]. | ||
357 | by apply map_Forall_insert_2. | ||
358 | + rewrite dom_insert_L. naive_solver. | ||
359 | + rewrite dom_insert_L. | ||
360 | apply interp_closed in Hinterp1; [|done..]. | ||
361 | rewrite /closed_val in Hinterp1. by destruct Hinterp1 as [_ ?]. | ||
362 | + apply interp_closed in Hinterp1; [|done..]. | ||
363 | rewrite /closed_val in Hinterp1. destruct Hinterp1 as [? _]. | ||
364 | apply subst_env_insert_eq; try naive_solver. | ||
365 | Qed. | ||
366 | |||
367 | Lemma subst_as_subst_env x e1 e2 : | ||
368 | subst {[x:=e2]} e1 = subst_env (<[x:=Thunk ∅ e2]> ∅) e1. | ||
369 | Proof. rewrite subst_env_insert //= !subst_env_empty //. Qed. | ||
370 | |||
371 | Lemma interp_subst n x e1 e2 mv : | ||
372 | closed {[x]} e1 → closed ∅ e2 → | ||
373 | interp n ∅ (subst {[x:=e2]} e1) = Res mv → | ||
374 | ∃ mw m, interp m (<[x:=Thunk ∅ e2]> ∅) e1 = Res mw ∧ | ||
375 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
376 | Proof. | ||
377 | intros He1 He2. | ||
378 | apply interp_proper. | ||
379 | - done. | ||
380 | - by apply closed_env_insert. | ||
381 | - apply subst_closed. | ||
382 | + by apply map_Forall_singleton. | ||
383 | + by rewrite dom_singleton_L dom_empty_L union_empty_r_L. | ||
384 | - by rewrite insert_empty dom_singleton_L. | ||
385 | - by rewrite subst_env_empty subst_as_subst_env. | ||
386 | Qed. | ||
387 | |||
388 | Lemma closed_step e1 e2 : closed ∅ e1 → e1 --> e2 → closed ∅ e2. | ||
389 | Proof. | ||
390 | intros Hclosed Hstep. revert Hclosed. | ||
391 | induction Hstep; intros He1closed. | ||
392 | - simplify_eq/=. destruct He1closed. | ||
393 | apply subst_closed. | ||
394 | + by eapply map_Forall_singleton. | ||
395 | + by rewrite dom_singleton_L. | ||
396 | - simplify_eq/=. destruct He1closed. auto. | ||
397 | Qed. | ||
398 | |||
399 | Lemma closed_steps e1 e2 : closed ∅ e1 → e1 -->* e2 → closed ∅ e2. | ||
400 | Proof. induction 2; eauto using closed_step. Qed. | ||
401 | |||
402 | Lemma interp_step e1 e2 n v : | ||
403 | closed ∅ e1 → | ||
404 | e1 --> e2 → | ||
405 | interp n ∅ e2 = Res v → | ||
406 | ∃ w m, interp m ∅ e1 = Res w ∧ val_to_expr <$> v = val_to_expr <$> w. | ||
407 | Proof. | ||
408 | intros He1closed Hstep. revert v n He1closed. | ||
409 | induction Hstep as [|???? IH]; intros v n He1closed Hinterp. | ||
410 | { rewrite /= union_empty_r_L in He1closed. | ||
411 | destruct He1closed as [He1closed He2closed]. | ||
412 | apply interp_subst in Hinterp as (w & [|m] & Hinterp & Hv); | ||
413 | simplify_eq/=; [|done..]. | ||
414 | exists w, (S (S m)). by rewrite !interp_S /= -interp_S. } | ||
415 | simpl in He1closed. destruct He1closed as [He1closed He2closed]. | ||
416 | destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
417 | destruct (interp n _ _) eqn:Hinterp'; simplify_res. | ||
418 | destruct x; simplify_res; last first. | ||
419 | { apply IH in Hinterp' as (mw' & m1 & Hinterp1 & ?); simplify_res; last done. | ||
420 | destruct mw'; try done. exists None, (S m1). | ||
421 | by rewrite interp_S /= Hinterp1. } | ||
422 | apply closed_step in Hstep as He1'closed; last done. | ||
423 | apply interp_closed in Hinterp' as Hcloclosed; | ||
424 | [|done|by rewrite dom_empty_L]. | ||
425 | apply IH in Hinterp' as ([] & m1 & Hinterp1 & ?); simplify_eq/=; last done. | ||
426 | destruct (maybe3 VClo _) eqn:Hclo; simplify_res; last first. | ||
427 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
428 | by assert (maybe3 VClo v1 = None) as -> by (by destruct v1, v0). } | ||
429 | simplify_option_eq. | ||
430 | simpl in Hcloclosed. destruct Hcloclosed as [HEclosed Heclosed]. | ||
431 | apply interp_closed in Hinterp1 as Hcloclosed; | ||
432 | [|done|by rewrite dom_empty_L]. simpl in Hcloclosed. | ||
433 | destruct v1; simplify_option_eq. | ||
434 | destruct Hcloclosed as [HE0closed He0closed]. | ||
435 | eapply interp_proper with (E2 := <[x0:=Thunk ∅ e2]> E0) (e2 := e0) | ||
436 | in Hinterp as (w & m2 & Hinterp2 & Hv); last apply subst_env_insert_eq. | ||
437 | { exists w, (S (m1 `max` m2)). rewrite !interp_S /=. | ||
438 | rewrite (interp_le Hinterp1) /=; last lia. | ||
439 | by rewrite (interp_le Hinterp2) /=; last lia. } | ||
440 | - by apply closed_env_insert. | ||
441 | - by apply closed_env_insert. | ||
442 | - by rewrite dom_insert_L. | ||
443 | - by rewrite dom_insert_L. | ||
444 | - done. | ||
445 | - done. | ||
446 | - done. | ||
447 | - done. | ||
448 | Qed. | ||
449 | |||
450 | Lemma final_interp e : | ||
451 | final e → | ||
452 | ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w. | ||
453 | Proof. | ||
454 | induction e; inv 1. | ||
455 | - eexists (VString _), 1. by rewrite interp_S /=. | ||
456 | - eexists (VClo _ _ _), 1. rewrite interp_S /=. split; [done|]. | ||
457 | by rewrite delete_empty subst_env_empty. | ||
458 | Qed. | ||
459 | |||
460 | Lemma red_final_interp e : | ||
461 | red step e ∨ final e ∨ ∃ m, interp m ∅ e = mfail. | ||
462 | Proof. | ||
463 | induction e. | ||
464 | - (* ENat *) right; left. constructor. | ||
465 | - (* EId *) do 2 right. by exists 1. | ||
466 | - (* EAbs *) right; left. constructor. | ||
467 | - (* EApp *) destruct IHe1 as [[??]|[Hfinal|[m Hinterp]]]. | ||
468 | + left. by repeat econstructor. | ||
469 | + apply final_interp in Hfinal as (w & m & Hinterp & ->). | ||
470 | destruct (maybe3 VClo w) eqn:Hw. | ||
471 | { destruct w; simplify_eq/=. left. by repeat econstructor. } | ||
472 | do 2 right. exists (S m). by rewrite interp_S /= Hinterp /= Hw. | ||
473 | + do 2 right. exists (S m). by rewrite interp_S /= Hinterp. | ||
474 | Qed. | ||
475 | |||
476 | Lemma interp_complete e1 e2 : | ||
477 | closed ∅ e1 → | ||
478 | e1 -->* e2 → | ||
479 | nf step e2 → | ||
480 | ∃ mw m, interp m ∅ e1 = Res mw ∧ | ||
481 | if mw is Some w then e2 = val_to_expr w else ¬final e2. | ||
482 | Proof. | ||
483 | intros He1 Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH]. | ||
484 | { destruct (red_final_interp e) as [?|[Hfinal|[m Hinterp]]]; [done|..]. | ||
485 | - apply final_interp in Hfinal as (w & m & ? & ?). | ||
486 | by exists (Some w), m. | ||
487 | - exists None, m. split; [done|]. intros Hfinal. | ||
488 | apply final_interp in Hfinal as (w & m' & ? & _). | ||
489 | by assert (mfail = mret w) by eauto using interp_agree. } | ||
490 | apply closed_step in Hstep as He2; last assumption. | ||
491 | destruct IH as (mw & m & Hinterp & ?); try done. | ||
492 | eapply interp_step in Hinterp as (mw' & m' & ? & ?). | ||
493 | - destruct mw, mw'; naive_solver. | ||
494 | - done. | ||
495 | - done. | ||
496 | Qed. | ||
497 | |||
498 | Lemma interp_complete_ret e1 e2 : | ||
499 | closed ∅ e1 → | ||
500 | e1 -->* e2 → final e2 → | ||
501 | ∃ w m, interp m ∅ e1 = mret w ∧ e2 = val_to_expr w. | ||
502 | Proof. | ||
503 | intros Hclosed Hsteps Hfinal. apply interp_complete in Hsteps | ||
504 | as ([w|] & m & ? & ?); naive_solver eauto using final_nf. | ||
505 | Qed. | ||
506 | Lemma interp_complete_fail e1 e2 : | ||
507 | closed ∅ e1 → | ||
508 | e1 -->* e2 → nf step e2 → ¬final e2 → | ||
509 | ∃ m, interp m ∅ e1 = mfail. | ||
510 | Proof. | ||
511 | intros Hclosed Hsteps Hnf Hforce. | ||
512 | apply interp_complete in Hsteps as ([w|] & m & ? & ?); simplify_eq/=; try by eauto. | ||
513 | destruct Hforce. apply final_val_to_expr. | ||
514 | Qed. | ||
515 | |||
516 | Lemma interp_sound_open E e n mv : | ||
517 | closed_env E → closed (dom E) e → | ||
518 | interp n E e = Res mv → | ||
519 | ∃ e', subst_env E e -->* e' ∧ | ||
520 | if mv is Some v then e' = val_to_expr v else stuck e'. | ||
521 | Proof. | ||
522 | revert E e mv. | ||
523 | induction n as [|n IH]; intros E e mv HEclosed Heclosed Hinterp; first done. | ||
524 | rewrite subst_env_eq. rewrite interp_S in Hinterp. | ||
525 | destruct e; simplify_res. | ||
526 | - (* ENat *) by eexists. | ||
527 | - (* EId *) destruct (_ !! _) as [[E' e]|] eqn:Hx; simplify_res. | ||
528 | + apply closed_env_lookup in Hx as Hxclosed; last done. | ||
529 | rewrite closed_thunk_eq in Hxclosed. destruct_and!. | ||
530 | apply IH in Hinterp as (e' & Hsteps & He'); naive_solver. | ||
531 | + eexists; repeat split; [done| |inv 1]. intros [? Hstep]. inv Hstep. | ||
532 | - (* EAbs *) by eexists. | ||
533 | - (* EApp *) destruct_and!. | ||
534 | destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
535 | apply interp_closed in Hinterp' as Hvclosed; [|done..]. | ||
536 | apply IH in Hinterp' as (e' & Hsteps & He'); [|done..]. | ||
537 | destruct mv' as [v'|]; simplify_res; last first. | ||
538 | { eexists; repeat split; [by apply SAppL_rtc| |inv 1]. | ||
539 | intros [e'' Hstep]. destruct He' as [Hnf Hfinal]. | ||
540 | inv Hstep; [by destruct Hfinal; constructor|]. destruct Hnf. eauto. } | ||
541 | destruct (maybe3 VClo v') eqn:?; simplify_res; last first. | ||
542 | { eexists; repeat split; [by apply SAppL_rtc| |inv 1]. | ||
543 | intros [e'' Hstep]. inv Hstep; destruct v'; by repeat inv_step. } | ||
544 | destruct v'; simplify_res. destruct_and!. | ||
545 | apply IH in Hinterp as (e'' & Hsteps' & He''). | ||
546 | + eexists; split; [|done]. etrans; [by apply SAppL_rtc|]. | ||
547 | eapply rtc_l; first by constructor. | ||
548 | rewrite subst_env_insert // in Hsteps'. | ||
549 | + by apply closed_env_insert. | ||
550 | + by rewrite dom_insert_L. | ||
551 | Qed. | ||
552 | |||
553 | Lemma interp_sound n e mv : | ||
554 | closed ∅ e → | ||
555 | interp n ∅ e = Res mv → | ||
556 | ∃ e', e -->* e' ∧ if mv is Some v then e' = val_to_expr v else stuck e'. | ||
557 | Proof. | ||
558 | intros He Hsteps%interp_sound_open; try done. | ||
559 | by rewrite subst_env_empty in Hsteps. | ||
560 | Qed. | ||
561 | |||
562 | (** Final theorems *) | ||
563 | Theorem interp_sound_complete_ret e v : | ||
564 | closed ∅ e → | ||
565 | (∃ w n, interp n ∅ e = mret w ∧ val_to_expr v = val_to_expr w) | ||
566 | ↔ e -->* val_to_expr v. | ||
567 | Proof. | ||
568 | split. | ||
569 | - by intros (n & w & (e' & ? & ->)%interp_sound & ->). | ||
570 | - intros Hsteps. apply interp_complete in Hsteps as ([] & ? & ? & ?); | ||
571 | unfold nf, red; | ||
572 | naive_solver eauto using final_val_to_expr, step_not_val_to_expr. | ||
573 | Qed. | ||
574 | |||
575 | Theorem interp_sound_complete_ret_string e s : | ||
576 | closed ∅ e → | ||
577 | (∃ n, interp n ∅ e = mret (VString s)) ↔ e -->* EString s. | ||
578 | Proof. | ||
579 | split. | ||
580 | - by intros [n (e' & ? & ->)%interp_sound]. | ||
581 | - intros Hsteps. apply interp_complete_ret in Hsteps as ([] & ? & ? & ?); | ||
582 | simplify_eq/=; eauto. | ||
583 | Qed. | ||
584 | |||
585 | Theorem interp_sound_complete_fail e : | ||
586 | closed ∅ e → | ||
587 | (∃ n, interp n ∅ e = mfail) ↔ ∃ e', e -->* e' ∧ stuck e'. | ||
588 | Proof. | ||
589 | split. | ||
590 | - by intros [n ?%interp_sound]. | ||
591 | - intros (e' & Hsteps & Hnf & Hforced). by eapply interp_complete_fail. | ||
592 | Qed. | ||
593 | |||
594 | Theorem interp_sound_complete_no_fuel e : | ||
595 | closed ∅ e → | ||
596 | (∀ n, interp n ∅ e = NoFuel) ↔ all_loop step e. | ||
597 | Proof. | ||
598 | rewrite all_loop_alt. split. | ||
599 | - intros Hnofuel e' Hsteps. | ||
600 | destruct (red_final_interp e') as [|[|He']]; [done|..]. | ||
601 | + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); [|done..]. | ||
602 | by rewrite Hnofuel in Hinterp. | ||
603 | + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]); | ||
604 | last by eauto using closed_steps. | ||
605 | destruct (interp_complete e e'') as (mv & n & Hinterp & _); [done|by etrans|done|]. | ||
606 | by rewrite Hnofuel in Hinterp. | ||
607 | - intros Hred n. destruct (interp n ∅ e) as [mv|] eqn:Hinterp; [|done]. | ||
608 | apply interp_sound in Hinterp as (e' & Hsteps%Hred & Hstuck); [|done]. | ||
609 | destruct mv as [v|]; simplify_eq/=. | ||
610 | + apply final_nf in Hsteps as []. apply final_val_to_expr. | ||
611 | + by destruct Hstuck as [[] ?]. | ||
612 | Qed. | ||
613 | |||
614 | End lambda. | ||
diff --git a/theories/lambda/operational.v b/theories/lambda/operational.v new file mode 100644 index 0000000..b0fa366 --- /dev/null +++ b/theories/lambda/operational.v | |||
@@ -0,0 +1,38 @@ | |||
1 | From mininix Require Export utils. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import lambda. | ||
5 | |||
6 | Inductive expr := | ||
7 | | EString (s : string) | ||
8 | | EId (x : string) | ||
9 | | EAbs (x : string) (e : expr) | ||
10 | | EApp (e1 e2 : expr). | ||
11 | |||
12 | Fixpoint subst (ds : gmap string expr) (e : expr) : expr := | ||
13 | match e with | ||
14 | | EString s => EString s | ||
15 | | EId x => if ds !! x is Some d then d else EId x | ||
16 | | EAbs x e => EAbs x (subst (delete x ds) e) | ||
17 | | EApp e1 e2 => EApp (subst ds e1) (subst ds e2) | ||
18 | end. | ||
19 | |||
20 | Reserved Infix "-->" (right associativity, at level 55). | ||
21 | Inductive step : expr → expr → Prop := | ||
22 | | Sβ x e1 e2 : EApp (EAbs x e1) e2 --> subst {[x:=e2]} e1 | ||
23 | | SAppL e1 e1' e2 : e1 --> e1' → EApp e1 e2 --> EApp e1' e2 | ||
24 | where "e1 --> e2" := (step e1 e2). | ||
25 | |||
26 | Infix "-->*" := (rtc step) (right associativity, at level 55). | ||
27 | |||
28 | Definition final (e : expr) : Prop := | ||
29 | match e with | ||
30 | | EString _ => True | ||
31 | | EAbs _ _ => True | ||
32 | | _ => False | ||
33 | end. | ||
34 | |||
35 | Definition stuck (e : expr) : Prop := | ||
36 | nf step e ∧ ¬final e. | ||
37 | |||
38 | End lambda. | ||
diff --git a/theories/lambda/operational_props.v b/theories/lambda/operational_props.v new file mode 100644 index 0000000..c331924 --- /dev/null +++ b/theories/lambda/operational_props.v | |||
@@ -0,0 +1,29 @@ | |||
1 | From mininix Require Export lambda.operational. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Module Import lambda. | ||
5 | Export lambda. | ||
6 | |||
7 | (** Properties of operational semantics *) | ||
8 | Lemma step_not_final e1 e2 : e1 --> e2 → ¬final e1. | ||
9 | Proof. induction 1; inv 1; naive_solver. Qed. | ||
10 | Lemma final_nf e : final e → nf step e. | ||
11 | Proof. by intros ? [??%step_not_final]. Qed. | ||
12 | |||
13 | Lemma SAppL_rtc e1 e1' e2 : e1 -->* e1' → EApp e1 e2 -->* EApp e1' e2. | ||
14 | Proof. induction 1; repeat (done || econstructor). Qed. | ||
15 | |||
16 | Ltac inv_step := repeat | ||
17 | match goal with H : ?e --> _ |- _ => assert_fails (is_var e); inv H end. | ||
18 | |||
19 | Lemma step_det e d1 d2 : | ||
20 | e --> d1 → | ||
21 | e --> d2 → | ||
22 | d1 = d2. | ||
23 | Proof. | ||
24 | intros Hred1. revert d2. | ||
25 | induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step. | ||
26 | f_equal. by apply IHHred1. | ||
27 | Qed. | ||
28 | |||
29 | End lambda. | ||
diff --git a/theories/nix/floats.v b/theories/nix/floats.v new file mode 100644 index 0000000..246e0c3 --- /dev/null +++ b/theories/nix/floats.v | |||
@@ -0,0 +1,85 @@ | |||
1 | From stdpp Require Import prelude ssreflect. | ||
2 | From Flocq.IEEE754 Require Import | ||
3 | Binary BinarySingleNaN (mode_NE, mode_DN, mode_UP) Bits. | ||
4 | From stdpp Require Import options. | ||
5 | |||
6 | Global Arguments B754_zero {_ _}. | ||
7 | Global Arguments B754_infinity {_ _}. | ||
8 | Global Arguments B754_nan {_ _}. | ||
9 | Global Arguments B754_finite {_ _}. | ||
10 | |||
11 | (** The bit representation of floats is not observable in Nix, and it appears | ||
12 | that only negative NaNs are ever produced. So we setup the Flocq floats in | ||
13 | the way that it always produces [-NaN], i.e., [indef_nan]. *) | ||
14 | Definition float := binary64. | ||
15 | |||
16 | Variant round_mode := Floor | Ceil | NearestEven. | ||
17 | Global Instance round_mode_eq_dec : EqDecision round_mode. | ||
18 | Proof. solve_decision. Defined. | ||
19 | |||
20 | Module Float. | ||
21 | Definition prec : Z := 53. | ||
22 | Definition emax : Z := 1024. | ||
23 | |||
24 | Lemma Hprec : (0 < 53)%Z. | ||
25 | Proof. done. Qed. | ||
26 | Lemma Hprec_emax : (53 < 1024)%Z. | ||
27 | Proof. done. Qed. | ||
28 | |||
29 | Global Instance inhabited : Inhabited float := populate (B754_zero false). | ||
30 | |||
31 | Global Instance eq_dec : EqDecision float. | ||
32 | Proof. | ||
33 | refine (λ f1 f2, | ||
34 | match f1, f2 with | ||
35 | | B754_zero s1, B754_zero s2 => cast_if (decide (s1 = s2)) | ||
36 | | B754_infinity s1, B754_infinity s2 => cast_if (decide (s1 = s2)) | ||
37 | | B754_nan s1 pl1 _, B754_nan s2 pl2 _ => | ||
38 | cast_if_and (decide (s1 = s2)) (decide (pl1 = pl2)) | ||
39 | | B754_finite s1 m1 e1 _, B754_finite s2 m2 e2 _ => | ||
40 | cast_if_and3 (decide (s1 = s2)) (decide (m1 = m2)) (decide (e1 = e2)) | ||
41 | | _, _ => right _ | ||
42 | end); abstract naive_solver (f_equal; apply (proof_irrel _)). | ||
43 | Defined. | ||
44 | |||
45 | Definition of_Z (x : Z) : float := | ||
46 | binary_normalize prec emax (refl_equal _) (refl_equal _) mode_NE x 0 false. | ||
47 | |||
48 | Definition to_Z (f : float) : option Z := | ||
49 | match f with | ||
50 | | B754_zero _ => Some 0 | ||
51 | | B754_finite s m e _ => Some (Zaux.cond_Zopp s (Zpos m) ≪ e) | ||
52 | | _ => None | ||
53 | end%Z. | ||
54 | |||
55 | (** QNaN Floating-Point Indefinite; see Table 4-3. Floating-Point Number and | ||
56 | NaN Encodings. *) | ||
57 | Definition indef_nan : { f | is_nan prec emax f = true } := | ||
58 | @B754_nan prec emax true (2^51) (refl_equal _) ↾ eq_refl _. | ||
59 | |||
60 | Definition to_flocq_round_mode (m : round_mode) : BinarySingleNaN.mode := | ||
61 | match m with Floor => mode_DN | Ceil => mode_UP | NearestEven => mode_NE end. | ||
62 | |||
63 | Definition round (m : round_mode) : float → float := | ||
64 | Bnearbyint prec emax (refl_equal _) (λ _, indef_nan) (to_flocq_round_mode m). | ||
65 | |||
66 | (* For add: not [mode_DN]; otherwise [+0.0 + -0.0] would yield [-0.0], but | ||
67 | [inf / (+0.0 + -0.0)] yields [inf] in C++, so this cannot be the case. *) | ||
68 | (* C++ compiles floating point addition to the x86 ADDSD instruction. Looking | ||
69 | at the Intel x86 Software Developer's Manual, it seems that the default | ||
70 | rounding mode on x86 is Round to Nearest (even); see table 4-8. (In §4.8.4.) *) | ||
71 | Definition add : float → float → float := | ||
72 | Bplus _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE. | ||
73 | Definition sub : float → float → float := | ||
74 | Bminus _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE. | ||
75 | Definition mul : float → float → float := | ||
76 | Bmult _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE. | ||
77 | Definition div : float → float → float := | ||
78 | Bdiv _ _ Hprec Hprec_emax (λ _ _, indef_nan) mode_NE. | ||
79 | |||
80 | Definition eqb (f1 f2 : float) : bool := | ||
81 | bool_decide (b64_compare f1 f2 = Some Eq). | ||
82 | |||
83 | Definition ltb (f1 f2 : float) : bool := | ||
84 | bool_decide (b64_compare f1 f2 = Some Lt). | ||
85 | End Float. | ||
diff --git a/theories/nix/interp.v b/theories/nix/interp.v new file mode 100644 index 0000000..bb4e815 --- /dev/null +++ b/theories/nix/interp.v | |||
@@ -0,0 +1,351 @@ | |||
1 | From Coq Require Import Ascii. | ||
2 | From mininix Require Export res nix.operational_props. | ||
3 | From stdpp Require Import options. | ||
4 | |||
5 | Section val. | ||
6 | Local Unset Elimination Schemes. | ||
7 | Inductive val := | ||
8 | | VLit (bl : base_lit) (Hbl : base_lit_ok bl) | ||
9 | | VClo (x : string) (E : gmap string (kind * thunk)) (e : expr) | ||
10 | | VCloMatch (E : gmap string (kind * thunk)) | ||
11 | (ms : gmap string (option expr)) | ||
12 | (strict : bool) (e : expr) | ||
13 | | VList (ts : list thunk) | ||
14 | | VAttr (ts : gmap string thunk) | ||
15 | with thunk := | ||
16 | | Forced (v : val) : thunk | ||
17 | | Thunk (E : gmap string (kind * thunk)) (e : expr) : thunk | ||
18 | | Indirect (x : string) | ||
19 | (E : gmap string (kind * thunk)) | ||
20 | (tαs : gmap string (expr + thunk)). | ||
21 | End val. | ||
22 | |||
23 | Notation VLitI bl := (VLit bl I). | ||
24 | |||
25 | Notation tattr := (expr + thunk)%type. | ||
26 | Notation env := (gmap string (kind * thunk)). | ||
27 | |||
28 | Definition maybe_VLit (v : val) : option base_lit := | ||
29 | if v is VLit bl _ then Some bl else None. | ||
30 | Global Instance maybe_VList : Maybe VList := λ v, | ||
31 | if v is VList ts then Some ts else None. | ||
32 | Global Instance maybe_VAttr : Maybe VAttr := λ v, | ||
33 | if v is VAttr ts then Some ts else None. | ||
34 | |||
35 | Fixpoint interp_eq_list_body (i : nat) (ts1 ts2 : list thunk) : expr := | ||
36 | match ts1, ts2 with | ||
37 | | [], [] => ELit (LitBool true) | ||
38 | | _ :: ts1, _ :: ts2 => | ||
39 | EIf (EBinOp EqOp (EId' ("1" +:+ pretty i)) (EId' ("2" +:+ pretty i))) | ||
40 | (interp_eq_list_body (S i) ts1 ts2) (ELit (LitBool false)) | ||
41 | | _, _ => ELit (LitBool false) | ||
42 | end. | ||
43 | |||
44 | Definition interp_eq_list (ts1 ts2 : list thunk) : thunk := | ||
45 | Thunk (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪ | ||
46 | kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2)) $ | ||
47 | interp_eq_list_body 0 ts1 ts2. | ||
48 | |||
49 | Fixpoint interp_lt_list_body (i : nat) (ts1 ts2 : list thunk) : expr := | ||
50 | match ts1, ts2 with | ||
51 | | [], _ => ELit (LitBool true) | ||
52 | | _ :: ts1, _ :: ts2 => | ||
53 | EIf (EBinOp LtOp (EId' ("1" +:+ pretty i)) (EId' ("2" +:+ pretty i))) | ||
54 | (ELit (LitBool true)) | ||
55 | (EIf (EBinOp EqOp (EId' ("1" +:+ pretty i)) (EId' ("2" +:+ pretty i))) | ||
56 | (interp_lt_list_body (S i) ts1 ts2) (ELit (LitBool false))) | ||
57 | | _ :: _, [] => ELit (LitBool false) | ||
58 | end. | ||
59 | |||
60 | Definition interp_lt_list (ts1 ts2 : list thunk) : thunk := | ||
61 | Thunk (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪ | ||
62 | kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2)) $ | ||
63 | interp_lt_list_body 0 ts1 ts2. | ||
64 | |||
65 | Definition interp_eq_attr (ts1 ts2 : gmap string thunk) : thunk := | ||
66 | Thunk (kmap (String "1") ((ABS,.) <$> ts1) ∪ | ||
67 | kmap (String "2") ((ABS,.) <$> ts2)) $ | ||
68 | sem_and_attr $ map_imap (λ x _, | ||
69 | Some (EBinOp EqOp (EId' ("1" +:+ x)) (EId' ("2" +:+ x)))) ts1. | ||
70 | |||
71 | Definition interp_eq (v1 v2 : val) : option thunk := | ||
72 | match v1, v2 with | ||
73 | | VLit bl1 _, VLit bl2 _ => | ||
74 | Some $ Forced $ VLitI (LitBool $ sem_eq_base_lit bl1 bl2) | ||
75 | | VClo _ _ _, VClo _ _ _ => None | ||
76 | | VList ts1, VList ts2 => Some $ | ||
77 | if decide (length ts1 = length ts2) then interp_eq_list ts1 ts2 | ||
78 | else Forced $ VLitI (LitBool false) | ||
79 | | VAttr ts1, VAttr ts2 => Some $ | ||
80 | if decide (dom ts1 = dom ts2) then interp_eq_attr ts1 ts2 | ||
81 | else Forced $ VLitI (LitBool false) | ||
82 | | _, _ => Some $ Forced $ VLitI (LitBool false) | ||
83 | end. | ||
84 | |||
85 | Definition type_of_val (v : val) : string := | ||
86 | match v with | ||
87 | | VLit bl _ => type_of_base_lit bl | ||
88 | | VClo _ _ _ | VCloMatch _ _ _ _ => "lambda" | ||
89 | | VList _ => "list" | ||
90 | | VAttr _ => "set" | ||
91 | end. | ||
92 | |||
93 | Global Instance val_inhabited : Inhabited val := populate (VLitI inhabitant). | ||
94 | Global Instance thunk_inhabited : Inhabited thunk := populate (Forced inhabitant). | ||
95 | |||
96 | Definition interp_bin_op (op : bin_op) (v1 : val) : option (val → option thunk) := | ||
97 | if decide (op = EqOp) then | ||
98 | Some (interp_eq v1) | ||
99 | else if decide (op = TypeOfOp) then | ||
100 | Some $ λ v2, | ||
101 | guard (maybe_VLit v2 = Some LitNull);; | ||
102 | Some $ Forced $ VLitI (LitString $ type_of_val v1) | ||
103 | else | ||
104 | match v1 with | ||
105 | | VLit (LitNum n1) Hn1 => | ||
106 | if maybe RoundOp op is Some m then | ||
107 | Some $ λ v2, | ||
108 | guard (maybe_VLit v2 = Some LitNull);; | ||
109 | Some $ Forced $ VLit | ||
110 | (LitNum $ NInt $ float_to_bounded_Z $ Float.round m $ num_to_float n1) | ||
111 | (float_to_bounded_Z_ok _) | ||
112 | else | ||
113 | '(f ↾ Hf) ← option_to_eq_Some (sem_bin_op_num op n1); | ||
114 | Some $ λ v2, | ||
115 | if v2 is VLit (LitNum n2) Hn2 then | ||
116 | '(bl ↾ Hbl) ← option_to_eq_Some (f n2); | ||
117 | Some $ Forced $ VLit bl (sem_bin_op_num_ok Hn1 Hn2 Hf Hbl) | ||
118 | else None | ||
119 | | VLit (LitString s1) _ => | ||
120 | match op with | ||
121 | | SingletonAttrOp => Some $ λ v2, | ||
122 | guard (maybe_VLit v2 = Some LitNull);; | ||
123 | Some $ Forced $ VClo "t" ∅ (EAttr {[ s1 := AttrN (EId' "t") ]}) | ||
124 | | MatchStringOp => Some $ λ v2, | ||
125 | guard (maybe_VLit v2 = Some LitNull);; | ||
126 | match s1 with | ||
127 | | EmptyString => Some $ Forced $ VAttr {[ | ||
128 | "empty" := Forced (VLitI (LitBool true)); | ||
129 | "head" := Forced (VLitI LitNull); | ||
130 | "tail" := Forced (VLitI LitNull) ]} | ||
131 | | String a s1 => Some $ Forced $ VAttr {[ | ||
132 | "empty" := Forced (VLitI (LitBool false)); | ||
133 | "head" := Forced (VLitI (LitString (String a EmptyString))); | ||
134 | "tail" := Forced (VLitI (LitString s1)) ]} | ||
135 | end | ||
136 | | _ => | ||
137 | '(f ↾ Hf) ← option_to_eq_Some (sem_bin_op_string op); | ||
138 | Some $ λ v2, | ||
139 | bl2 ← maybe_VLit v2; | ||
140 | s2 ← maybe LitString bl2; | ||
141 | Some $ Forced $ VLit (f s1 s2) (sem_bin_op_string_ok Hf) | ||
142 | end | ||
143 | | VClo _ _ _ => | ||
144 | match op with | ||
145 | | FunctionArgsOp => Some $ λ v2, | ||
146 | guard (maybe_VLit v2 = Some LitNull);; | ||
147 | Some (Forced (VAttr ∅)) | ||
148 | | _ => None | ||
149 | end | ||
150 | | VCloMatch _ ms _ _ => | ||
151 | match op with | ||
152 | | FunctionArgsOp => Some $ λ v2, | ||
153 | guard (maybe_VLit v2 = Some LitNull);; | ||
154 | Some $ Forced $ VAttr $ | ||
155 | (λ m, Forced $ VLitI (LitBool (from_option (λ _, true) false m))) <$> ms | ||
156 | | _ => None | ||
157 | end | ||
158 | | VList ts1 => | ||
159 | match op with | ||
160 | | LtOp => Some $ λ v2, | ||
161 | ts2 ← maybe VList v2; | ||
162 | Some (interp_lt_list ts1 ts2) | ||
163 | | MatchListOp => Some $ λ v2, | ||
164 | guard (maybe_VLit v2 = Some LitNull);; | ||
165 | match ts1 with | ||
166 | | [] => Some $ Forced $ VAttr {[ | ||
167 | "empty" := Forced (VLitI (LitBool true)); | ||
168 | "head" := Forced (VLitI LitNull); | ||
169 | "tail" := Forced (VLitI LitNull) ]} | ||
170 | | t :: ts1 => Some $ Forced $ VAttr {[ | ||
171 | "empty" := Forced (VLitI (LitBool false)); | ||
172 | "head" := t; | ||
173 | "tail" := Forced (VList ts1) ]} | ||
174 | end | ||
175 | | AppendListOp => Some $ λ v2, | ||
176 | ts2 ← maybe VList v2; | ||
177 | Some (Forced (VList (ts1 ++ ts2))) | ||
178 | | _ => None | ||
179 | end | ||
180 | | VAttr ts1 => | ||
181 | match op with | ||
182 | | SelectAttrOp => Some $ λ v2, | ||
183 | bl ← maybe_VLit v2; | ||
184 | x ← maybe LitString bl; | ||
185 | ts1 !! x | ||
186 | | UpdateAttrOp => Some $ λ v2, | ||
187 | ts2 ← maybe VAttr v2; | ||
188 | Some $ Forced $ VAttr $ ts2 ∪ ts1 | ||
189 | | HasAttrOp => Some $ λ v2, | ||
190 | bl ← maybe_VLit v2; | ||
191 | x ← maybe LitString bl; | ||
192 | Some $ Forced $ VLitI (LitBool $ bool_decide (is_Some (ts1 !! x))) | ||
193 | | DeleteAttrOp => Some $ λ v2, | ||
194 | bl ← maybe_VLit v2; | ||
195 | x ← maybe LitString bl; | ||
196 | Some $ Forced $ VAttr $ delete x ts1 | ||
197 | | MatchAttrOp => Some $ λ v2, | ||
198 | guard (maybe_VLit v2 = Some LitNull);; | ||
199 | match map_minimal_key attr_le ts1 with | ||
200 | | None => Some $ Forced $ VAttr {[ | ||
201 | "empty" := Forced (VLitI (LitBool true)); | ||
202 | "key" := Forced (VLitI LitNull); | ||
203 | "head" := Forced (VLitI LitNull); | ||
204 | "tail" := Forced (VLitI LitNull) ]} | ||
205 | | Some x => Some $ Forced $ VAttr {[ | ||
206 | "empty" := Forced (VLitI (LitBool false)); | ||
207 | "key" := Forced (VLitI (LitString x)); | ||
208 | "head" := ts1 !!! x; | ||
209 | "tail" := Forced (VAttr (delete x ts1)) ]} | ||
210 | end | ||
211 | | _ => None | ||
212 | end | ||
213 | | _ => None | ||
214 | end. | ||
215 | |||
216 | Definition interp_match | ||
217 | (ts : gmap string thunk) (mds : gmap string (option expr)) | ||
218 | (strict : bool) : option (gmap string tattr) := | ||
219 | map_mapM id $ merge (λ mt mmd, | ||
220 | (* Some (Some _) means keep, Some None means fail, None means skip *) | ||
221 | match mt, mmd with | ||
222 | | Some t, Some _ => Some $ Some (inr t) | ||
223 | | None, Some (Some e) => Some $ Some (inl e) | ||
224 | | None, Some _ => Some None (* bad *) | ||
225 | | Some _, None => guard strict;; Some None | ||
226 | | _, _ => None (* skip *) | ||
227 | end) ts mds. | ||
228 | |||
229 | Definition force_deep1 | ||
230 | (force_deep : val → res val) | ||
231 | (interp_thunk : thunk → res val) (v : val) : res val := | ||
232 | match v with | ||
233 | | VList ts => VList ∘ fmap Forced <$> | ||
234 | mapM (mbind force_deep ∘ interp_thunk) ts | ||
235 | | VAttr ts => VAttr ∘ fmap Forced <$> | ||
236 | map_mapM_sorted attr_le (mbind force_deep ∘ interp_thunk) ts | ||
237 | | _ => mret v | ||
238 | end. | ||
239 | |||
240 | Definition indirects_env (E : env) (tαs : gmap string tattr) : env := | ||
241 | map_imap (λ y _, Some (ABS, Indirect y E tαs)) tαs ∪ E. | ||
242 | |||
243 | Definition attr_to_tattr (E : env) (α : attr) : tattr := | ||
244 | from_attr inl (inr ∘ Thunk E) α. | ||
245 | |||
246 | Definition interp1 | ||
247 | (force_deep : val → res val) | ||
248 | (interp : env → expr → res val) | ||
249 | (interp_thunk : thunk → res val) | ||
250 | (interp_app : val → thunk → res val) | ||
251 | (E : env) (e : expr) : res val := | ||
252 | match e with | ||
253 | | ELit bl => | ||
254 | bl_ok ← guard (base_lit_ok bl); | ||
255 | mret (VLit bl bl_ok) | ||
256 | | EId x mke => | ||
257 | '(_,t) ← Res $ union_kinded (E !! x) (prod_map id (Thunk ∅) <$> mke); | ||
258 | interp_thunk t | ||
259 | | EAbs x e => mret (VClo x E e) | ||
260 | | EAbsMatch ms strict e => mret (VCloMatch E ms strict e) | ||
261 | | EApp e1 e2 => | ||
262 | v1 ← interp E e1; | ||
263 | interp_app v1 (Thunk E e2) | ||
264 | | ESeq μ' e1 e2 => | ||
265 | v ← interp E e1; | ||
266 | (if μ' is DEEP then force_deep else mret) v;; | ||
267 | interp E e2 | ||
268 | | EList es => mret (VList (Thunk E <$> es)) | ||
269 | | EAttr αs => | ||
270 | let E' := indirects_env E (attr_to_tattr E <$> αs) in | ||
271 | mret (VAttr (from_attr (Thunk E') (Thunk E) <$> αs)) | ||
272 | | ELetAttr k e1 e2 => | ||
273 | v1 ← interp E e1; | ||
274 | ts ← Res (maybe VAttr v1); | ||
275 | interp (union_kinded ((k,.) <$> ts) E) e2 | ||
276 | | EBinOp op e1 e2 => | ||
277 | v1 ← interp E e1; | ||
278 | f ← Res (interp_bin_op op v1); | ||
279 | v2 ← interp E e2; | ||
280 | t2 ← Res (f v2); | ||
281 | interp_thunk t2 | ||
282 | | EIf e1 e2 e3 => | ||
283 | v1 ← interp E e1; | ||
284 | '(b : bool) ← Res (maybe_VLit v1 ≫= maybe LitBool); | ||
285 | interp E (if b then e2 else e3) | ||
286 | end. | ||
287 | |||
288 | Definition interp_thunk1 | ||
289 | (interp : env → expr → res val) | ||
290 | (interp_thunk : thunk → res val) | ||
291 | (t : thunk) : res val := | ||
292 | match t with | ||
293 | | Forced v => mret v | ||
294 | | Thunk E e => interp E e | ||
295 | | Indirect x E tαs => | ||
296 | tα ← Res $ tαs !! x; | ||
297 | match tα with | ||
298 | | inl e => interp (indirects_env E tαs) e | ||
299 | | inr t => interp_thunk t | ||
300 | end | ||
301 | end. | ||
302 | |||
303 | Definition interp_app1 | ||
304 | (interp : env → expr → res val) | ||
305 | (interp_thunk : thunk → res val) | ||
306 | (interp_app : val → thunk → res val) | ||
307 | (v1 : val) (t2 : thunk) : res val := | ||
308 | match v1 with | ||
309 | | VClo x E e => | ||
310 | interp (<[x:=(ABS, t2)]> E) e | ||
311 | | VCloMatch E ms strict e => | ||
312 | vt ← interp_thunk t2; | ||
313 | ts ← Res (maybe VAttr vt); | ||
314 | tαs ← Res $ interp_match ts ms strict; | ||
315 | interp (indirects_env E tαs) e | ||
316 | | VAttr ts => | ||
317 | t ← Res (ts !! "__functor"); | ||
318 | vt ← interp_thunk t; | ||
319 | v ← interp_app vt (Forced v1); | ||
320 | interp_app v t2 | ||
321 | | _ => mfail | ||
322 | end. | ||
323 | |||
324 | Fixpoint force_deep (n : nat) (v : val) : res val := | ||
325 | match n with | ||
326 | | O => NoFuel | ||
327 | | S n => force_deep1 (force_deep n) (interp_thunk n) v | ||
328 | end | ||
329 | with interp (n : nat) (E : env) (e : expr) : res val := | ||
330 | match n with | ||
331 | | O => NoFuel | ||
332 | | S n => interp1 (force_deep n) (interp n) (interp_thunk n) (interp_app n) E e | ||
333 | end | ||
334 | with interp_thunk (n : nat) (t : thunk) : res val := | ||
335 | match n with | ||
336 | | O => NoFuel | ||
337 | | S n => interp_thunk1 (interp n) (interp_thunk n) t | ||
338 | end | ||
339 | with interp_app (n : nat) (v1 : val) (t2 : thunk) : res val := | ||
340 | match n with | ||
341 | | O => NoFuel | ||
342 | | S n => interp_app1 (interp n) (interp_thunk n) (interp_app n) v1 t2 | ||
343 | end. | ||
344 | |||
345 | Definition force_deep' (n : nat) (μ : mode) : val → res val := | ||
346 | match μ with SHALLOW => mret | DEEP => force_deep n end. | ||
347 | |||
348 | Definition interp' (n : nat) (μ : mode) (E : env) (e : expr) : res val := | ||
349 | interp n E e ≫= force_deep' n μ. | ||
350 | |||
351 | Global Opaque force_deep interp interp_thunk interp_app. | ||
diff --git a/theories/nix/interp_proofs.v b/theories/nix/interp_proofs.v new file mode 100644 index 0000000..5780e48 --- /dev/null +++ b/theories/nix/interp_proofs.v | |||
@@ -0,0 +1,2690 @@ | |||
1 | From Coq Require Import Ascii. | ||
2 | From mininix Require Export nix.interp. | ||
3 | From stdpp Require Import options. | ||
4 | |||
5 | Lemma force_deep_S n : | ||
6 | force_deep (S n) = force_deep1 (force_deep n) (interp_thunk n). | ||
7 | Proof. done. Qed. | ||
8 | Lemma interp_S n : | ||
9 | interp (S n) = interp1 (force_deep n) (interp n) (interp_thunk n) (interp_app n). | ||
10 | Proof. done. Qed. | ||
11 | Lemma interp_thunk_S n : | ||
12 | interp_thunk (S n) = interp_thunk1 (interp n) (interp_thunk n). | ||
13 | Proof. done. Qed. | ||
14 | Lemma interp_app_S n : | ||
15 | interp_app (S n) = interp_app1 (interp n) (interp_thunk n) (interp_app n). | ||
16 | Proof. done. Qed. | ||
17 | |||
18 | Lemma interp_shallow' m E e : interp' m SHALLOW E e = interp m E e. | ||
19 | Proof. rewrite /interp'. by destruct (interp _ _ _) as [[]|]. Qed. | ||
20 | |||
21 | Lemma interp_lit n E bl (Hbl : base_lit_ok bl) : | ||
22 | interp (S n) E (ELit bl) = mret (VLit bl Hbl). | ||
23 | Proof. | ||
24 | rewrite interp_S /=. case_guard; simpl; [|done]. | ||
25 | do 2 f_equal. apply (proof_irrel _). | ||
26 | Qed. | ||
27 | |||
28 | (** Induction *) | ||
29 | Fixpoint val_size (v : val) : nat := | ||
30 | match v with | ||
31 | | VLit _ _ => 1 | ||
32 | | VClo _ E _ | VCloMatch E _ _ _ => S (map_sum_with (thunk_size ∘ snd) E) | ||
33 | | VList ts => S (sum_list_with thunk_size ts) | ||
34 | | VAttr ts => S (map_sum_with thunk_size ts) | ||
35 | end | ||
36 | with thunk_size (t : thunk) : nat := | ||
37 | match t with | ||
38 | | Forced v => S (val_size v) | ||
39 | | Thunk E _ => S (map_sum_with (thunk_size ∘ snd) E) | ||
40 | | Indirect _ E tαs => S (map_sum_with (thunk_size ∘ snd) E + | ||
41 | map_sum_with (from_sum (λ _, 1) thunk_size) tαs) | ||
42 | end. | ||
43 | Notation env_size := (map_sum_with (thunk_size ∘ snd)). | ||
44 | |||
45 | Definition from_thunk {A} (f : val → A) (g : env → expr → A) | ||
46 | (h : string → env → gmap string tattr → A) (t : thunk) : A := | ||
47 | match t with | ||
48 | | Forced v => f v | ||
49 | | Thunk E e => g E e | ||
50 | | Indirect x E tαs => h x E tαs | ||
51 | end. | ||
52 | |||
53 | Lemma env_val_ind (P : env → Prop) (Q : val → Prop) : | ||
54 | (∀ E, | ||
55 | map_Forall (λ _, from_thunk Q (λ E _, P E) (λ _ E _, P E) ∘ snd) E → P E) → | ||
56 | (∀ b Hbl, Q (VLit b Hbl)) → | ||
57 | (∀ x E e, P E → Q (VClo x E e)) → | ||
58 | (∀ E ms strict e, P E → Q (VCloMatch E ms strict e)) → | ||
59 | (∀ ts, Forall (from_thunk Q (λ E _, P E) (λ _ E _, P E)) ts → Q (VList ts)) → | ||
60 | (∀ ts, map_Forall (λ _, from_thunk Q (λ E _, P E) (λ _ E _, P E)) ts → Q (VAttr ts)) → | ||
61 | (∀ E, P E) ∧ (∀ v, Q v). | ||
62 | Proof. | ||
63 | intros Penv Qlit Qclo Qmatch Qlist Qattr. | ||
64 | cut (∀ n, (∀ E, env_size E < n → P E) ∧ (∀ v, val_size v < n → Q v)). | ||
65 | { intros Hhelp; split. | ||
66 | - intros E. apply (Hhelp (S (env_size E))); lia. | ||
67 | - intros v. apply (Hhelp (S (val_size v))); lia. } | ||
68 | intros n. induction n as [|n IH]; [by auto with lia|]. split. | ||
69 | - intros E ?. apply Penv, map_Forall_lookup=> y [k ei] Hy. | ||
70 | apply (map_sum_with_lookup_le (thunk_size ∘ snd)) in Hy; simpl in *. | ||
71 | destruct ei as [v|E' e'|x E' tαs]; simplify_eq/=; try apply IH; eauto with lia. | ||
72 | - intros [] ?; simpl in *. | ||
73 | + apply Qlit. | ||
74 | + apply Qclo, IH. lia. | ||
75 | + apply Qmatch, IH. lia. | ||
76 | + apply Qlist, Forall_forall=> t Hy. | ||
77 | apply (sum_list_with_in _ thunk_size) in Hy. | ||
78 | destruct t; simpl in *; try apply IH; lia. | ||
79 | + apply Qattr, map_Forall_lookup=> y t Hy. | ||
80 | apply (map_sum_with_lookup_le thunk_size) in Hy. | ||
81 | destruct t; simpl in *; try apply IH; lia. | ||
82 | Qed. | ||
83 | |||
84 | Lemma env_ind (P : env → Prop) : | ||
85 | (∀ E, | ||
86 | map_Forall (λ i, from_thunk (λ _, True) (λ E _, P E) (λ _ E _, P E) ∘ snd) E → | ||
87 | P E) → | ||
88 | ∀ E : env, P E. | ||
89 | Proof. intros. apply (env_val_ind P (λ _, True)); auto. Qed. | ||
90 | |||
91 | Lemma val_ind (Q : val → Prop) : | ||
92 | (∀ bl Hbl, Q (VLit bl Hbl)) → | ||
93 | (∀ x E e, Q (VClo x E e)) → | ||
94 | (∀ ms strict E e, Q (VCloMatch ms strict E e)) → | ||
95 | (∀ ts, Forall (from_thunk Q (λ _ _, True) (λ _ _ _, True)) ts → Q (VList ts)) → | ||
96 | (∀ ts, | ||
97 | map_Forall (λ _, from_thunk Q (λ _ _, True) (λ _ _ _, True)) ts → Q (VAttr ts)) → | ||
98 | (∀ v, Q v). | ||
99 | Proof. intros. apply (env_val_ind (λ _, True) Q); auto. Qed. | ||
100 | (** Correspondence to operational semantics *) | ||
101 | Definition subst_env' (thunk_to_expr : thunk → expr) (E : env) : expr → expr := | ||
102 | subst (prod_map id thunk_to_expr <$> E). | ||
103 | |||
104 | Definition tattr_to_attr' | ||
105 | (thunk_to_expr : thunk → expr) (subst_env : env → expr → expr) | ||
106 | (E : env) (α : tattr) : attr := | ||
107 | from_sum (AttrR ∘ subst_env E) (AttrN ∘ thunk_to_expr) α. | ||
108 | |||
109 | Fixpoint thunk_to_expr (t : thunk) : expr := | ||
110 | match t with | ||
111 | | Forced v => val_to_expr v | ||
112 | | Thunk E e => subst_env' thunk_to_expr E e | ||
113 | | Indirect x E tαs => ESelect | ||
114 | (EAttr (tattr_to_attr' thunk_to_expr (subst_env' thunk_to_expr) E <$> tαs)) x | ||
115 | end | ||
116 | with val_to_expr (v : val) : expr := | ||
117 | match v with | ||
118 | | VLit bl _ => ELit bl | ||
119 | | VClo x E e => EAbs x (subst_env' thunk_to_expr E e) | ||
120 | | VCloMatch E ms strict e => EAbsMatch | ||
121 | (fmap (M:=option) (subst_env' thunk_to_expr E) <$> ms) | ||
122 | strict | ||
123 | (subst_env' thunk_to_expr E e) | ||
124 | | VList ts => EList (thunk_to_expr <$> ts) | ||
125 | | VAttr ts => EAttr (AttrN ∘ thunk_to_expr <$> ts) | ||
126 | end. | ||
127 | |||
128 | Notation subst_env := (subst_env' thunk_to_expr). | ||
129 | Notation tattr_to_attr := (tattr_to_attr' thunk_to_expr subst_env). | ||
130 | Notation attr_subst_env E := (attr_map (subst_env E)). | ||
131 | |||
132 | Lemma subst_env_eq e E : | ||
133 | subst_env E e = | ||
134 | match e with | ||
135 | | ELit n => ELit n | ||
136 | | EId x mkd => EId x $ | ||
137 | union_kinded (prod_map id thunk_to_expr <$> E !! x) mkd | ||
138 | | EAbs x e => EAbs x (subst_env E e) | ||
139 | | EAbsMatch ms strict e => | ||
140 | EAbsMatch (fmap (M:=option) (subst_env E) <$> ms) strict (subst_env E e) | ||
141 | | EApp e1 e2 => EApp (subst_env E e1) (subst_env E e2) | ||
142 | | ESeq μ e1 e2 => ESeq μ (subst_env E e1) (subst_env E e2) | ||
143 | | EList es => EList (subst_env E <$> es) | ||
144 | | EAttr αs => EAttr (attr_subst_env E <$> αs) | ||
145 | | ELetAttr k e1 e2 => ELetAttr k (subst_env E e1) (subst_env E e2) | ||
146 | | EBinOp op e1 e2 => EBinOp op (subst_env E e1) (subst_env E e2) | ||
147 | | EIf e1 e2 e3 => EIf (subst_env E e1) (subst_env E e2) (subst_env E e3) | ||
148 | end. | ||
149 | Proof. rewrite /subst_env. destruct e; by rewrite /= ?lookup_fmap. Qed. | ||
150 | |||
151 | Lemma subst_env_alt E e : subst_env E e = subst (prod_map id thunk_to_expr <$> E) e. | ||
152 | Proof. done. Qed. | ||
153 | |||
154 | (* Use the unfolding lemmas, don't rely on conversion *) | ||
155 | Opaque subst_env'. | ||
156 | |||
157 | Lemma subst_env_empty e : subst_env ∅ e = e. | ||
158 | Proof. rewrite subst_env_alt. apply subst_empty. Qed. | ||
159 | |||
160 | Lemma final_val_to_expr v : final SHALLOW (val_to_expr v). | ||
161 | Proof. induction v; simpl; constructor; auto. Qed. | ||
162 | Local Hint Resolve final_val_to_expr | 0 : core. | ||
163 | Lemma step_not_val_to_expr v e : val_to_expr v -{SHALLOW}-> e → False. | ||
164 | Proof. intros []%step_not_final. done. Qed. | ||
165 | |||
166 | Lemma final_force_deep n t v : | ||
167 | force_deep n t = mret v → final DEEP (val_to_expr v). | ||
168 | Proof. | ||
169 | revert t v. induction n as [|n IH]; intros v w; [done|]. | ||
170 | rewrite force_deep_S /=. | ||
171 | intros; destruct v; simplify_res; eauto using final. | ||
172 | + destruct (mapM _ _) as [[vs|]|] eqn:Hmap; simplify_res; eauto. | ||
173 | constructor. revert vs Hmap. | ||
174 | induction ts as [|t ts IHts]; intros; simplify_res; [by constructor|..]. | ||
175 | destruct (interp_thunk _ _) as [[w|]|]; simplify_res. | ||
176 | destruct (force_deep _ _) as [[w'|]|] eqn:?; simplify_res. | ||
177 | destruct (mapM _ _) as [[ws|]|]; simplify_res; eauto. | ||
178 | + destruct (map_mapM_sorted _ _ _) as [[vs|]|] eqn:Hmap; simplify_res. | ||
179 | constructor; [done|]. | ||
180 | revert vs Hmap. induction ts as [|x t ts ?? IHts] | ||
181 | using (map_sorted_ind attr_le); intros ts' Hts. | ||
182 | { rewrite map_mapM_sorted_empty in Hts; simplify_res. done. } | ||
183 | rewrite map_mapM_sorted_insert //= in Hts. | ||
184 | destruct (interp_thunk _ _) as [[w|]|] eqn:?; simplify_res. | ||
185 | destruct (force_deep _ _) as [[w'|]|] eqn:?; simplify_res. | ||
186 | destruct (map_mapM_sorted _ _ _) as [[ws|]|] eqn:Hmap; simplify_res. | ||
187 | rewrite !fmap_insert /=. apply map_Forall_insert_2, IHts; eauto. | ||
188 | Qed. | ||
189 | |||
190 | Lemma interp_bin_op_Some_1 op v1 f : | ||
191 | interp_bin_op op v1 = Some f → | ||
192 | ∃ Φ, sem_bin_op op (val_to_expr v1) Φ. | ||
193 | Proof. | ||
194 | intros Hinterp. unfold interp_bin_op, interp_eq in *. | ||
195 | repeat (case_match || simplify_option_eq); | ||
196 | eexists; by repeat econstructor; eauto using final. | ||
197 | Qed. | ||
198 | |||
199 | Lemma interp_bin_op_Some_2 op v1 Φ : | ||
200 | sem_bin_op op (val_to_expr v1) Φ → | ||
201 | is_Some (interp_bin_op op v1). | ||
202 | Proof. | ||
203 | unfold interp_bin_op; destruct v1; inv 1; | ||
204 | repeat (case_match || simplify_option_eq); eauto. | ||
205 | destruct (option_to_eq_Some _) as [[??]|] eqn:Ho; simplify_eq/=; eauto. | ||
206 | by rewrite H2 in Ho. | ||
207 | Qed. | ||
208 | |||
209 | Lemma interp_eq_list_correct ts1 ts2 : | ||
210 | thunk_to_expr (interp_eq_list ts1 ts2) =D=> | ||
211 | sem_eq_list (thunk_to_expr <$> ts1) (thunk_to_expr <$> ts2). | ||
212 | Proof. | ||
213 | simpl. | ||
214 | remember (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪ | ||
215 | kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2)) | ||
216 | as E eqn:HE. | ||
217 | assert (∀ (i : nat) t, ts1 !! i = Some t → | ||
218 | E !! String "1" (pretty (i + 0)) = Some (ABS, t)) as Hts1. | ||
219 | { intros x t Hxt. rewrite Nat.add_0_r. | ||
220 | rewrite HE lookup_union (lookup_kmap _) lookup_fmap. | ||
221 | rewrite lookup_map_seq_0 Hxt /= union_Some_l. done. } | ||
222 | assert (∀ (i : nat) t, ts2 !! i = Some t → | ||
223 | E !! String "2" (pretty (i + 0)) = Some (ABS, t)) as Hts2. | ||
224 | { intros x t Hxt. rewrite Nat.add_0_r. | ||
225 | rewrite HE lookup_union_r; last by apply (lookup_kmap_None _). | ||
226 | rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0 Hxt /=. done. } | ||
227 | clear HE. revert ts2 Hts1 Hts2. generalize 0. | ||
228 | induction ts1 as [|t1 ts1 IH]; intros n [|t2 ts2] Hts1 Hts2; csimpl; [done..|]. | ||
229 | rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /=. rewrite /String.app. | ||
230 | rewrite (Hts1 0 t1) // (Hts2 0 t2) //=. | ||
231 | constructor; [repeat constructor| |done]. | ||
232 | apply IH; intros i t; rewrite Nat.add_succ_r; | ||
233 | [apply (Hts1 (S i))|apply (Hts2 (S i))]. | ||
234 | Qed. | ||
235 | |||
236 | Lemma interp_lt_list_correct ts1 ts2 : | ||
237 | thunk_to_expr (interp_lt_list ts1 ts2) =D=> | ||
238 | sem_lt_list (thunk_to_expr <$> ts1) (thunk_to_expr <$> ts2). | ||
239 | Proof. | ||
240 | simpl. | ||
241 | remember (kmap (λ n : nat, String "1" (pretty n)) ((ABS,.) <$> map_seq 0 ts1) ∪ | ||
242 | kmap (λ n : nat, String "2" (pretty n)) ((ABS,.) <$> map_seq 0 ts2)) | ||
243 | as E eqn:HE. | ||
244 | assert (∀ (i : nat) t, ts1 !! i = Some t → | ||
245 | E !! String "1" (pretty (i + 0)) = Some (ABS, t)) as Hts1. | ||
246 | { intros x t Hxt. rewrite Nat.add_0_r. | ||
247 | rewrite HE lookup_union (lookup_kmap _) lookup_fmap. | ||
248 | rewrite lookup_map_seq_0 Hxt /= union_Some_l. done. } | ||
249 | assert (∀ (i : nat) t, ts2 !! i = Some t → | ||
250 | E !! String "2" (pretty (i + 0)) = Some (ABS, t)) as Hts2. | ||
251 | { intros x t Hxt. rewrite Nat.add_0_r. | ||
252 | rewrite HE lookup_union_r; last by apply (lookup_kmap_None _). | ||
253 | rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0 Hxt /=. done. } | ||
254 | clear HE. revert ts2 Hts1 Hts2. generalize 0. | ||
255 | induction ts1 as [|t1 ts1 IH]; intros n [|t2 ts2] Hts1 Hts2; csimpl; [done..|]. | ||
256 | rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /=. rewrite /String.app. | ||
257 | rewrite (Hts1 0 t1) // (Hts2 0 t2) //=. | ||
258 | constructor; [repeat constructor..|]. | ||
259 | rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /=. | ||
260 | rewrite (Hts1 0 t1) // (Hts2 0 t2) //=. | ||
261 | constructor; [repeat constructor| |done]. | ||
262 | apply IH; intros i t; rewrite Nat.add_succ_r; | ||
263 | [apply (Hts1 (S i))|apply (Hts2 (S i))]. | ||
264 | Qed. | ||
265 | |||
266 | Lemma interp_eq_attr_correct ts1 ts2 : | ||
267 | dom ts1 = dom ts2 → | ||
268 | thunk_to_expr (interp_eq_attr ts1 ts2) =D=> | ||
269 | sem_eq_attr (AttrN ∘ thunk_to_expr <$> ts1) (AttrN ∘ thunk_to_expr <$> ts2). | ||
270 | Proof. | ||
271 | intros Hdom. simpl. | ||
272 | remember (kmap (String "1") ((ABS,.) <$> ts1) ∪ | ||
273 | kmap (String "2") ((ABS,.) <$> ts2)) as E eqn:HE. | ||
274 | assert (map_Forall (λ x t, E !! String "1" x = Some (ABS, t)) ts1) as Hts1. | ||
275 | { intros x t Hxt. | ||
276 | rewrite HE lookup_union (lookup_kmap (String "1")) lookup_fmap. | ||
277 | by rewrite Hxt /= union_Some_l. } | ||
278 | assert (map_Forall (λ x t, E !! String "2" x = Some (ABS, t)) ts2) as Hts2. | ||
279 | { intros x t Hxt. | ||
280 | rewrite HE lookup_union_r; last by apply (lookup_kmap_None _). | ||
281 | by rewrite (lookup_kmap (String "2")) lookup_fmap Hxt. } | ||
282 | clear HE. revert ts2 Hdom Hts1 Hts2. | ||
283 | induction ts1 as [|x t1 ts1 Hts1x IH] using (map_sorted_ind attr_le); | ||
284 | intros ts2 Hdom Hts1 Hts2. | ||
285 | { apply symmetry, dom_empty_inv_L in Hdom as ->. done. } | ||
286 | rewrite dom_insert_L in Hdom. | ||
287 | assert (is_Some (ts2 !! x)) as [t2 Hxt2] by (apply elem_of_dom; set_solver). | ||
288 | assert (dom ts1 = dom (delete x ts2)). | ||
289 | { rewrite dom_delete_L -Hdom. apply not_elem_of_dom in Hts1x. set_solver. } | ||
290 | rewrite -(insert_delete ts2 x t2) //. rewrite -(insert_delete ts2 x t2) // in Hts2. | ||
291 | apply map_Forall_insert in Hts1 as [Hx1 Hts1]; last done. | ||
292 | apply map_Forall_insert in Hts2 as [Hx2 Hts2]; last by rewrite lookup_delete. | ||
293 | rewrite /sem_eq_attr !fmap_insert /=. erewrite <-insert_merge by done. | ||
294 | rewrite sem_and_attr_insert; first last. | ||
295 | { intros y. rewrite lookup_merge !lookup_fmap /is_Some. | ||
296 | destruct (ts1 !! y) eqn:? , (delete x ts2 !! y); naive_solver. } | ||
297 | { rewrite lookup_merge !lookup_fmap lookup_delete /=. by destruct (ts1 !! x). } | ||
298 | rewrite map_imap_insert sem_and_attr_insert; first last. | ||
299 | { intros y. rewrite map_lookup_imap /is_Some. | ||
300 | destruct (ts1 !! y) eqn:?; naive_solver. } | ||
301 | { by rewrite map_lookup_imap Hts1x. } | ||
302 | rewrite 4!subst_env_eq /= !(subst_env_eq (ELit _)) /= Hx1 Hx2 /=. | ||
303 | constructor; [|apply IHts1; by auto|done]. by do 2 constructor. | ||
304 | Qed. | ||
305 | |||
306 | Lemma interp_bin_op_Some_Some_1 op v1 f Φ v2 t3 : | ||
307 | interp_bin_op op v1 = Some f → | ||
308 | sem_bin_op op (val_to_expr v1) Φ → | ||
309 | f v2 = Some t3 → | ||
310 | ∃ e3, Φ (val_to_expr v2) e3 ∧ thunk_to_expr t3 =D=> e3. | ||
311 | Proof. | ||
312 | unfold interp_bin_op, interp_eq, type_of_val, type_of_expr; | ||
313 | destruct v1, v2; inv 2; intros; | ||
314 | repeat match goal with | ||
315 | | _ => progress simplify_option_eq | ||
316 | | H : _ <$> _ = ∅ |- _ => apply fmap_empty_inv in H | ||
317 | | H : context [dom (_ <$> _)] |- _ => rewrite !dom_fmap_L in H | ||
318 | | H : context [length (_ <$> _)] |- _ => rewrite !length_fmap in H | ||
319 | | _ => case_match | ||
320 | | _ => eexists; split; [done|] | ||
321 | | _ => by apply interp_eq_list_correct | ||
322 | | _ => eexists; split; [|by apply: interp_lt_list_correct] | ||
323 | | _ => by apply: interp_eq_attr_correct | ||
324 | | _ => eexists; split; [|done] | ||
325 | | _ => split; [|done] | ||
326 | | _ => rewrite map_fmap_singleton | ||
327 | | _ => rewrite fmap_delete | ||
328 | | _ => rewrite subst_env_empty | ||
329 | | _ => rewrite fmap_app | ||
330 | | _ => rewrite lookup_fmap | ||
331 | | _ => by constructor | ||
332 | end; eauto using final. | ||
333 | - apply reflexive_eq. f_equal. apply map_eq=> x. | ||
334 | rewrite !lookup_fmap. by destruct (_ !! _) as [[]|]. | ||
335 | - by destruct (ts !! _). | ||
336 | - apply (map_minimal_key_Some _) in H as [[t Hx] ?]. | ||
337 | split; [done|]. right. eexists s, _; split_and!. | ||
338 | + by rewrite lookup_fmap Hx. | ||
339 | + intros y. rewrite lookup_fmap fmap_is_Some. auto. | ||
340 | + rewrite 3!fmap_insert map_fmap_singleton /=. | ||
341 | by rewrite lookup_total_alt Hx fmap_delete. | ||
342 | - apply map_minimal_key_None in H as ->. auto. | ||
343 | - split; [done|]. by rewrite map_fmap_union. | ||
344 | Qed. | ||
345 | |||
346 | Lemma interp_bin_op_Some_Some_2 op v1 f Φ v2 e3 : | ||
347 | interp_bin_op op v1 = Some f → | ||
348 | sem_bin_op op (val_to_expr v1) Φ → | ||
349 | Φ (val_to_expr v2) e3 → | ||
350 | ∃ t3, f v2 = Some t3 ∧ thunk_to_expr t3 =D=> e3. | ||
351 | Proof. | ||
352 | unfold interp_bin_op, interp_eq; destruct v1; inv 2; intros; | ||
353 | repeat match goal with | ||
354 | | H : ∃ _, _ |- _ => destruct H | ||
355 | | H : _ ∧ _ |- _ => destruct H | ||
356 | | H : _ <$> _ = ∅ |- _ => apply fmap_empty_inv in H | ||
357 | | H : context [(_ <$> _) !! _ = _] |- _ => rewrite lookup_fmap in H | ||
358 | | H : context [dom (_ <$> _)] |- _ => rewrite !dom_fmap_L in H | ||
359 | | H : context [length (_ <$> _)] |- _ => rewrite !length_fmap in H | ||
360 | | _ => progress simplify_option_eq | ||
361 | | H : val_to_expr ?v2 = _ |- _ => destruct v2 | ||
362 | | _ => case_match | ||
363 | | _ => eexists; split; [|by apply interp_eq_attr_correct] | ||
364 | | _ => eexists; split; [|by apply interp_eq_list_correct] | ||
365 | | _ => eexists; split; [|by apply interp_lt_list_correct] | ||
366 | | _ => eexists; split; [done|] | ||
367 | | _ => rewrite map_fmap_singleton | ||
368 | | _ => rewrite fmap_delete | ||
369 | | _ => rewrite subst_env_empty | ||
370 | | _ => rewrite fmap_app | ||
371 | | _ => rewrite map_fmap_union | ||
372 | end; eauto. | ||
373 | - rewrite (option_to_eq_Some_Some _ _ H1) /=. by eexists. | ||
374 | - apply reflexive_eq. f_equal. apply map_eq=> x. | ||
375 | rewrite !lookup_fmap. by destruct (_ !! _) as [[]|]. | ||
376 | - rewrite lookup_fmap. by destruct (_ !! _). | ||
377 | - destruct H1 as [[Hemp _]|(x & e' & Hx & Hleast & ->)]. | ||
378 | { by apply fmap_empty_inv in Hemp as ->. } | ||
379 | rewrite lookup_fmap fmap_Some in Hx. destruct Hx as (t & Hx & [= ->]). | ||
380 | setoid_rewrite lookup_fmap in Hleast. setoid_rewrite fmap_is_Some in Hleast. | ||
381 | apply (map_minimal_key_Some _) in H as [??]. | ||
382 | assert (s = x) as -> by (apply (anti_symm attr_le); naive_solver). | ||
383 | rewrite 3!fmap_insert map_fmap_singleton /= fmap_delete. | ||
384 | rewrite lookup_total_alt Hx. done. | ||
385 | - apply map_minimal_key_None in H as ->. naive_solver. | ||
386 | Qed. | ||
387 | |||
388 | Lemma interp_match_subst E ts ms strict : | ||
389 | interp_match ts (fmap (M:=option) (subst_env E) <$> ms) strict = | ||
390 | fmap (M:=gmap string) (sum_map (subst_env E) id) <$> interp_match ts ms strict. | ||
391 | Proof. | ||
392 | unfold interp_match. set (f mt mme := match mt with _ => _ end). | ||
393 | revert ts. induction ms as [|x mt ms Hmsx IH] using map_ind; intros ts. | ||
394 | { rewrite fmap_empty merge_empty_r. | ||
395 | induction ts as [|x t ts Hmsx IH] using map_ind; [done|]. | ||
396 | rewrite omap_insert /=. destruct strict; simplify_eq/=. | ||
397 | { rewrite map_mapM_insert_option //= lookup_omap Hmsx. done. } | ||
398 | rewrite -omap_delete delete_notin //. } | ||
399 | destruct (ts !! x) as [t|] eqn:Htsx. | ||
400 | { rewrite -(insert_delete ts x t) // fmap_insert. | ||
401 | rewrite -!(insert_merge _ _ _ _ (Some (inr t))) //. | ||
402 | rewrite !map_mapM_insert_option /=; | ||
403 | [|by rewrite lookup_merge lookup_delete ?lookup_fmap Hmsx..]. | ||
404 | rewrite IH. destruct (map_mapM id _); rewrite /= ?fmap_insert //. } | ||
405 | rewrite -(insert_merge_r _ _ _ _ (inl <$> mt)) /=; last first. | ||
406 | { rewrite Htsx /=. by destruct mt. } | ||
407 | rewrite fmap_insert. | ||
408 | rewrite -(insert_merge_r _ _ _ _ (inl <$> (subst_env E <$> mt))) /=; last first. | ||
409 | { rewrite Htsx /=. by destruct mt. } | ||
410 | rewrite !map_mapM_insert_option /=; | ||
411 | [|by rewrite lookup_merge ?lookup_fmap Htsx Hmsx..]. | ||
412 | rewrite IH. destruct mt, (map_mapM id _); rewrite /= ?fmap_insert //. | ||
413 | Qed. | ||
414 | |||
415 | Lemma interp_match_Some_1 ts ms strict tαs : | ||
416 | interp_match ts ms strict = Some tαs → | ||
417 | matches (thunk_to_expr <$> ts) ms strict (tattr_to_attr ∅ <$> tαs). | ||
418 | Proof. | ||
419 | unfold interp_match. set (f mt mme := match mt with _ => _ end). | ||
420 | revert ts tαs. | ||
421 | induction ms as [|x mt ms Hmsx IH] using map_ind; intros ts αs Hmatch. | ||
422 | { rewrite merge_empty_r in Hmatch. revert αs Hmatch. | ||
423 | induction ts as [|x t ts Hmsx IH] using map_ind; intros ts' Hmatch. | ||
424 | { rewrite omap_empty map_mapM_empty in Hmatch. injection Hmatch as <-. | ||
425 | rewrite !fmap_empty. constructor. } | ||
426 | rewrite omap_insert /= in Hmatch. destruct strict; simplify_eq/=. | ||
427 | { rewrite map_mapM_insert_option //= in Hmatch. by rewrite lookup_omap Hmsx. } | ||
428 | rewrite fmap_insert. | ||
429 | rewrite -omap_delete delete_notin // in Hmatch. apply IH in Hmatch. | ||
430 | apply matches_strict; rewrite ?lookup_fmap ?Hmsx; eauto. } | ||
431 | destruct (ts !! x) as [t|] eqn:Htsx. | ||
432 | { rewrite -(insert_delete ts x t) //. | ||
433 | rewrite -(insert_delete ts x t) // in Hmatch. | ||
434 | rewrite -(insert_merge _ _ _ _ (Some (inr t))) // in Hmatch. | ||
435 | rewrite map_mapM_insert_option /= in Hmatch; | ||
436 | last (by rewrite lookup_merge lookup_delete Hmsx). | ||
437 | destruct (map_mapM id _) as [E''|] eqn:?; simplify_eq/=. | ||
438 | injection Hmatch as <-. | ||
439 | rewrite !fmap_insert /=. constructor. | ||
440 | - by rewrite lookup_fmap lookup_delete. | ||
441 | - done. | ||
442 | - by apply IH. } | ||
443 | rewrite -(insert_merge_r _ _ _ _ (inl <$> mt)) /= in Hmatch; last first. | ||
444 | { rewrite Htsx /=. by destruct mt. } | ||
445 | rewrite map_mapM_insert_option /= in Hmatch; | ||
446 | last (by rewrite lookup_merge Htsx Hmsx). | ||
447 | destruct mt as [t|]; simplify_eq/=. | ||
448 | destruct (map_mapM id _) as [E''|] eqn:?; simplify_eq/=. | ||
449 | injection Hmatch as <-. rewrite !fmap_insert /= subst_env_empty. constructor. | ||
450 | - by rewrite lookup_fmap Htsx. | ||
451 | - done. | ||
452 | - by apply IH. | ||
453 | Qed. | ||
454 | |||
455 | Lemma interp_match_Some_2 es ms strict αs : | ||
456 | matches es ms strict αs → | ||
457 | interp_match (Thunk ∅ <$> es) ms strict = Some (attr_to_tattr ∅ <$> αs). | ||
458 | Proof. | ||
459 | unfold interp_match. set (f mt mme := match mt with _ => _ end). | ||
460 | induction 1; [done|..]. | ||
461 | - rewrite fmap_empty merge_empty_r. | ||
462 | induction es as [|x e es ? IH] using map_ind; [done|]. | ||
463 | rewrite fmap_insert omap_insert /= -omap_delete -fmap_delete delete_notin //. | ||
464 | - rewrite !fmap_insert /=. | ||
465 | rewrite -(insert_merge _ _ _ _ (Some (inr (Thunk ∅ e)))) //. | ||
466 | rewrite map_mapM_insert_option /=; last first. | ||
467 | { by rewrite lookup_merge !lookup_fmap H H0. } | ||
468 | by rewrite IHmatches. | ||
469 | - rewrite !fmap_insert /=. | ||
470 | rewrite -(insert_merge_r _ _ _ _ (Some (inl d))) /=; last first. | ||
471 | { by rewrite lookup_fmap H. } | ||
472 | rewrite map_mapM_insert_option /=; last first. | ||
473 | { by rewrite lookup_merge !lookup_fmap H H0. } | ||
474 | by rewrite IHmatches /=. | ||
475 | Qed. | ||
476 | |||
477 | Lemma force_deep_le {n1 n2 v mv} : | ||
478 | force_deep n1 v = Res mv → n1 ≤ n2 → force_deep n2 v = Res mv | ||
479 | with interp_le {n1 n2 E e mv} : | ||
480 | interp n1 E e = Res mv → n1 ≤ n2 → interp n2 E e = Res mv | ||
481 | with interp_thunk_le {n1 n2 t mvs} : | ||
482 | interp_thunk n1 t = Res mvs → n1 ≤ n2 → interp_thunk n2 t = Res mvs | ||
483 | with interp_app_le {n1 n2 v t mv} : | ||
484 | interp_app n1 v t = Res mv → n1 ≤ n2 → interp_app n2 v t = Res mv. | ||
485 | Proof. | ||
486 | - destruct n1 as [|n1], n2 as [|n2]; intros Ht ?; [done || lia..|]. | ||
487 | rewrite force_deep_S in Ht; rewrite force_deep_S; simpl in *. | ||
488 | destruct v as []; simplify_res; try done. | ||
489 | + destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_res. | ||
490 | erewrite mapM_Res_impl; [done..|]. intros t mw Hinterp; simpl in *. | ||
491 | destruct (interp_thunk n1 _) as [mw'|] eqn:Hinterp'; simplify_res. | ||
492 | rewrite (interp_thunk_le _ _ _ _ Hinterp') /=; last lia. | ||
493 | destruct mw'; simplify_res; eauto with lia. | ||
494 | + destruct (map_mapM_sorted _ _ _) eqn:?; simplify_res. | ||
495 | erewrite (map_mapM_sorted_Res_impl attr_le); [done..|]. | ||
496 | clear dependent ts. intros t mw Hinterp; simpl in *. | ||
497 | destruct (interp_thunk n1 _) as [mw'|] eqn:Hinterp'; simplify_res. | ||
498 | rewrite (interp_thunk_le _ _ _ _ Hinterp') /=; last lia. | ||
499 | destruct mw'; simplify_res; eauto with lia. | ||
500 | - destruct n1 as [|n1], n2 as [|n2]; intros He ?; [done || lia..|]. | ||
501 | rewrite interp_S in He; rewrite interp_S; destruct e; | ||
502 | repeat match goal with | ||
503 | | _ => case_match | ||
504 | | H : context [(_ <$> ?mx)] |- _ => destruct mx eqn:?; simplify_res | ||
505 | | H : ?r ≫= _ = _ |- _ => destruct r as [[]|] eqn:?; simplify_res | ||
506 | | H : _ <$> ?r = _ |- _ => destruct r as [[]|] eqn:?; simplify_res | ||
507 | | H : interp ?n' _ _ = Res ?mv |- interp ?n ?E ?e ≫= _ = _ => | ||
508 | rewrite (interp_le n' n E e mv); [|done || lia..] | ||
509 | | H : interp_app ?n' _ _ = Res ?mv |- interp_app ?n ?E ?e ≫= _ = _ => | ||
510 | rewrite (interp_app_le n' n E e mv); [|done || lia..] | ||
511 | | H : force_deep ?n' _ = Res ?mv |- force_deep ?n ?t ≫= _ = _ => | ||
512 | rewrite (force_deep_le n' n t mv); [|done || lia..] | ||
513 | | _ => progress simplify_res | ||
514 | | _ => progress simplify_option_eq | ||
515 | end; eauto with lia. | ||
516 | - destruct n1 as [|n1], n2 as [|n2]; intros He ?; [by (done || lia)..|]. | ||
517 | rewrite interp_thunk_S in He. rewrite interp_thunk_S. | ||
518 | destruct t; repeat (case_match || destruct (_ !! _) | ||
519 | || simplify_res); eauto with lia. | ||
520 | - destruct n1 as [|n1], n2 as [|n2]; intros He ?; [by (done || lia)..|]. | ||
521 | rewrite interp_app_S /= in He; rewrite interp_app_S /=. | ||
522 | destruct v; simplify_res; eauto with lia. | ||
523 | + destruct (interp_thunk n1 t) as [mw|] eqn:?; simplify_res. | ||
524 | erewrite interp_thunk_le by eauto with lia. simpl. | ||
525 | destruct mw as [w|]; simplify_res; [|done]. | ||
526 | destruct (maybe VAttr w) as [ts|]; simplify_res; [|done]. | ||
527 | destruct (interp_match _ _ _); simplify_res; eauto with lia. | ||
528 | + destruct (_ !! "__functor") as [tf|]; simplify_res; [|done]. | ||
529 | destruct (interp_thunk n1 tf) as [mw|] eqn:?; simplify_res. | ||
530 | erewrite interp_thunk_le by eauto with lia. simpl. | ||
531 | destruct mw as [w|]; simplify_res; [|done]. | ||
532 | destruct (interp_app n1 _ _) as [mw|] eqn:?; simplify_res. | ||
533 | erewrite interp_app_le by eauto with lia; simpl. | ||
534 | destruct mw; simplify_res; eauto with lia. | ||
535 | Qed. | ||
536 | |||
537 | Lemma mapM_interp_le {n1 n2 ts mvs} : | ||
538 | mapM (mbind (force_deep n1) ∘ interp_thunk n1) ts = Res mvs → | ||
539 | n1 ≤ n2 → | ||
540 | mapM (mbind (force_deep n2) ∘ interp_thunk n2) ts = Res mvs. | ||
541 | Proof. | ||
542 | intros. eapply mapM_Res_impl; [done|]; simpl; intros t mv ?. | ||
543 | destruct (interp_thunk _ _) as [mw|] eqn:Hthunk; simplify_res. | ||
544 | rewrite (interp_thunk_le Hthunk) //=. | ||
545 | destruct mw; simplify_res; eauto using force_deep_le. | ||
546 | Qed. | ||
547 | Lemma map_mapM_interp_le {n1 n2 ts mvs} : | ||
548 | map_mapM_sorted attr_le (mbind (force_deep n1) ∘ interp_thunk n1) ts = Res mvs → | ||
549 | n1 ≤ n2 → | ||
550 | map_mapM_sorted attr_le (mbind (force_deep n2) ∘ interp_thunk n2) ts = Res mvs. | ||
551 | Proof. | ||
552 | intros. eapply (map_mapM_sorted_Res_impl attr_le); [done|]; simpl. | ||
553 | intros t mv ?. destruct (interp_thunk _ _) as [mw|] eqn:Hthunk; simplify_res. | ||
554 | rewrite (interp_thunk_le Hthunk) //=. | ||
555 | destruct mw; simplify_res; eauto using force_deep_le. | ||
556 | Qed. | ||
557 | |||
558 | Lemma interp_agree {n1 n2 E e mv1 mv2} : | ||
559 | interp n1 E e = Res mv1 → interp n2 E e = Res mv2 → mv1 = mv2. | ||
560 | Proof. | ||
561 | intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2). | ||
562 | - rewrite -He2. symmetry. eauto using interp_le. | ||
563 | - rewrite -He1. eauto using interp_le. | ||
564 | Qed. | ||
565 | |||
566 | Lemma subst_env_union E1 E2 e : | ||
567 | subst_env (union_kinded E1 E2) e = subst_env E1 (subst_env E2 e). | ||
568 | Proof. | ||
569 | rewrite !subst_env_alt -subst_union. f_equal. apply map_eq=> x. | ||
570 | rewrite lookup_union_with !lookup_fmap lookup_union_with. | ||
571 | by repeat destruct (_ !! _) as [[[]]|]. | ||
572 | Qed. | ||
573 | |||
574 | Lemma union_kinded_union {A} (E1 E2 : gmap string (kind * A)) : | ||
575 | map_Forall (λ _ ka, ka.1 = ABS) E1 → union_kinded E1 E2 = E1 ∪ E2. | ||
576 | Proof. | ||
577 | rewrite map_Forall_lookup; intros. | ||
578 | apply map_eq=> x. rewrite lookup_union_with lookup_union. | ||
579 | destruct (E1 !! x) as [[[] a]|] eqn:?; naive_solver. | ||
580 | Qed. | ||
581 | |||
582 | Lemma subst_abs_env_insert E x e t : | ||
583 | subst_env (<[x:=(ABS, t)]> E) e | ||
584 | = subst {[x:=(ABS, thunk_to_expr t)]} (subst_env E e). | ||
585 | Proof. | ||
586 | assert (<[x:=(ABS, t)]> E = | ||
587 | union_kinded {[x:=(ABS, t)]} E) as ->. | ||
588 | { apply map_eq=> y. rewrite lookup_union_with. | ||
589 | destruct (decide (x = y)) as [->|]. | ||
590 | - rewrite lookup_insert lookup_singleton /=. by destruct (_ !! _). | ||
591 | - rewrite lookup_insert_ne // lookup_singleton_ne //. by destruct (_ !! _). } | ||
592 | rewrite subst_env_union subst_env_alt. by rewrite map_fmap_singleton. | ||
593 | Qed. | ||
594 | |||
595 | Lemma subst_abs_as_subst_env x e1 e2 : | ||
596 | subst {[x:=(ABS, e2)]} e1 = subst_env (<[x:=(ABS, Thunk ∅ e2)]> ∅) e1. | ||
597 | Proof. rewrite subst_abs_env_insert //= !subst_env_empty //. Qed. | ||
598 | |||
599 | Lemma subst_env_insert_proper e1 e2 E1 E2 x t1 t2 : | ||
600 | subst_env E1 e1 = subst_env E2 e2 → | ||
601 | thunk_to_expr t1 = thunk_to_expr t2 → | ||
602 | subst_env (<[x:=(ABS, t1)]> E1) e1 = subst_env (<[x:=(ABS, t2)]> E2) e2. | ||
603 | Proof. rewrite !subst_abs_env_insert //. auto with f_equal. Qed. | ||
604 | |||
605 | Lemma subst_env_insert_proper' e1 e2 E1 E2 x E1' E2' e1' e2' : | ||
606 | subst_env E1 e1 = subst_env E2 e2 → | ||
607 | subst_env E1' e1' = subst_env E2' e2' → | ||
608 | subst_env (<[x:=(ABS, Thunk E1' e1')]> E1) e1 | ||
609 | = subst_env (<[x:=(ABS, Thunk E2' e2')]> E2) e2. | ||
610 | Proof. intros. by apply subst_env_insert_proper. Qed. | ||
611 | |||
612 | Lemma subst_env_union_fmap_proper k e1 e2 E1 E2 ts1 ts2 : | ||
613 | subst_env E1 e1 = subst_env E2 e2 → | ||
614 | AttrN ∘ thunk_to_expr <$> ts1 = AttrN ∘ thunk_to_expr <$> ts2 → | ||
615 | subst_env (union_kinded ((k,.) <$> ts1) E1) e1 | ||
616 | = subst_env (union_kinded ((k,.) <$> ts2) E2) e2. | ||
617 | Proof. | ||
618 | intros He Hes. rewrite !subst_env_union; [|by apply env_unionable_with..]. | ||
619 | rewrite He !subst_env_alt /=. f_equal. | ||
620 | apply map_eq=> x. rewrite !lookup_fmap. | ||
621 | apply (f_equal (.!! x)) in Hes. rewrite !lookup_fmap in Hes. | ||
622 | destruct (ts1 !! x), (ts2 !! x); simplify_eq/=; auto with f_equal. | ||
623 | Qed. | ||
624 | |||
625 | Lemma subst_env_fmap_proper k e ts1 ts2 : | ||
626 | AttrN ∘ thunk_to_expr <$> ts1 = AttrN ∘ thunk_to_expr <$> ts2 → | ||
627 | subst_env ((k,.) <$> ts1) e = subst_env ((k,.) <$> ts2) e. | ||
628 | Proof. | ||
629 | intros. rewrite -(right_id_L ∅ (union_kinded) (_ <$> ts1)) | ||
630 | -(right_id_L ∅ (union_kinded) (_ <$> ts2)). | ||
631 | by apply subst_env_union_fmap_proper. | ||
632 | Qed. | ||
633 | |||
634 | Lemma tattr_to_attr_from_attr E (αs : gmap string attr) : | ||
635 | tattr_to_attr E <$> (attr_to_tattr E <$> αs) = attr_subst_env E <$> αs. | ||
636 | Proof. | ||
637 | apply map_eq=> x. rewrite /tattr_to_attr !lookup_fmap. | ||
638 | destruct (αs !! x) as [[[] ]|] eqn:?; auto. | ||
639 | Qed. | ||
640 | |||
641 | Lemma tattr_to_attr_from_attr_empty (αs : gmap string attr) : | ||
642 | tattr_to_attr ∅ <$> (attr_to_tattr ∅ <$> αs) = αs. | ||
643 | Proof. | ||
644 | rewrite tattr_to_attr_from_attr. apply map_eq=> x. rewrite !lookup_fmap. | ||
645 | destruct (αs !! x) as [[[] ]|] eqn:?; f_equal/=; by rewrite subst_env_empty. | ||
646 | Qed. | ||
647 | |||
648 | Lemma indirects_env_proper E1 E2 tαs1 tαs2 e1 e2 : | ||
649 | tattr_to_attr E1 <$> tαs1 = tattr_to_attr E2 <$> tαs2 → | ||
650 | subst_env E1 e1 = subst_env E2 e2 → | ||
651 | subst_env (indirects_env E1 tαs1) e1 = subst_env (indirects_env E2 tαs2) e2. | ||
652 | Proof. | ||
653 | intros Htαs HE. rewrite /indirects_env -!union_kinded_union; | ||
654 | [|intros ??; rewrite map_lookup_imap=> ?; by simplify_option_eq..]. | ||
655 | rewrite !subst_env_union HE !subst_env_alt. f_equal. | ||
656 | apply map_eq=> x. rewrite !lookup_fmap !map_lookup_imap. | ||
657 | pose proof (f_equal (.!! x) Htαs) as Hx. rewrite !lookup_fmap in Hx. | ||
658 | repeat destruct (_ !! x) as [[]|]; simplify_eq/=; auto with f_equal. | ||
659 | Qed. | ||
660 | |||
661 | Lemma subst_env_indirects_env E tαs e : | ||
662 | subst_env (indirects_env E tαs) e | ||
663 | = subst_env (indirects_env ∅ (attr_to_tattr ∅ <$> (tattr_to_attr E <$> tαs))) | ||
664 | (subst_env E e). | ||
665 | Proof. | ||
666 | rewrite /indirects_env -!union_kinded_union; | ||
667 | [|intros ??; rewrite map_lookup_imap=> ?; by simplify_option_eq..]. | ||
668 | rewrite !subst_env_union subst_env_empty !subst_env_alt. | ||
669 | f_equal. apply map_eq=> x. rewrite !lookup_fmap !map_lookup_imap !lookup_fmap. | ||
670 | destruct (_ !! _) as [[]|]; | ||
671 | do 4 f_equal/=; auto using tattr_to_attr_from_attr_empty. | ||
672 | Qed. | ||
673 | |||
674 | Lemma subst_env_indirects_env_attr_to_tattr E αs e : | ||
675 | subst_env (indirects_env E (attr_to_tattr E <$> αs)) e | ||
676 | = subst (indirects (attr_subst_env E <$> αs)) (subst_env E e). | ||
677 | Proof. | ||
678 | rewrite /indirects_env -!union_kinded_union; | ||
679 | [|intros ??; rewrite map_lookup_imap=> ?; by simplify_option_eq..]. | ||
680 | rewrite subst_env_union !subst_env_alt. f_equal. | ||
681 | apply map_eq=> x. rewrite !lookup_fmap !map_lookup_imap !lookup_fmap. | ||
682 | repeat destruct (_ !! x) as [[]|]; simplify_eq/=; do 4 f_equal/=. | ||
683 | by rewrite tattr_to_attr_from_attr. | ||
684 | Qed. | ||
685 | |||
686 | Lemma subst_env_indirects_env_attr_to_tattr_empty αs e : | ||
687 | subst_env (indirects_env ∅ (attr_to_tattr ∅ <$> αs)) e = | ||
688 | subst (indirects αs) e. | ||
689 | Proof. | ||
690 | rewrite subst_env_indirects_env_attr_to_tattr subst_env_empty. do 3 f_equal. | ||
691 | apply map_eq=> x. rewrite !lookup_fmap. | ||
692 | destruct (_ !! x) as [[]|]; do 2 f_equal/=; auto using subst_env_empty. | ||
693 | Qed. | ||
694 | |||
695 | Lemma interp_val_to_expr E e v : | ||
696 | subst_env E e = val_to_expr v → | ||
697 | ∃ w m, interp m E e = mret w ∧ val_to_expr v = val_to_expr w. | ||
698 | Proof. | ||
699 | revert v. induction e; intros []; | ||
700 | rewrite subst_env_eq; intros; simplify_eq/=. | ||
701 | - eexists (VLit _ ltac:(done)), 1. split; [|done]. by rewrite interp_lit. | ||
702 | - eexists (VClo _ _ _), 1. rewrite interp_S /=. auto with f_equal. | ||
703 | - eexists (VCloMatch _ _ _ _), 1. rewrite interp_S /=. auto with f_equal. | ||
704 | - eexists (VList _), 1. rewrite interp_S /=. split; [done|]. | ||
705 | f_equal. rewrite -H0. clear. | ||
706 | induction es; f_equal/=; auto. | ||
707 | - eexists (VAttr _), 1. rewrite interp_S /=. split; [done|]. | ||
708 | assert (no_recs αs) as Hrecs. | ||
709 | { intros y α Hy. | ||
710 | apply (f_equal (.!! y)) in H0. rewrite !lookup_fmap Hy /= in H0. | ||
711 | destruct (ts !! y), α; by simplify_eq/=. } | ||
712 | rewrite from_attr_no_recs // -H0. | ||
713 | f_equal. apply map_eq=> y. | ||
714 | rewrite !lookup_fmap. destruct (αs !! y) as [[]|] eqn:?; do 2 f_equal/=. | ||
715 | eauto using no_recs_lookup. | ||
716 | Qed. | ||
717 | |||
718 | Lemma interp_val_to_expr_Res m E e v mw : | ||
719 | subst_env E e = val_to_expr v → | ||
720 | interp m E e = Res mw → | ||
721 | Some (val_to_expr v) = val_to_expr <$> mw. | ||
722 | Proof. | ||
723 | intros (mw' & m' & Hinterp' & ->)%interp_val_to_expr Hinterp. | ||
724 | by assert (mw = Some mw') as -> by eauto using interp_agree. | ||
725 | Qed. | ||
726 | |||
727 | Lemma interp_empty_val_to_expr v : | ||
728 | ∃ w m, interp m ∅ (val_to_expr v) = mret w ∧ val_to_expr v = val_to_expr w. | ||
729 | Proof. apply interp_val_to_expr. by rewrite subst_env_empty. Qed. | ||
730 | |||
731 | Lemma interp_empty_val_to_expr_Res m v mw : | ||
732 | interp m ∅ (val_to_expr v) = Res mw → | ||
733 | Some (val_to_expr v) = val_to_expr <$> mw. | ||
734 | Proof. apply interp_val_to_expr_Res. by rewrite subst_env_empty. Qed. | ||
735 | |||
736 | Lemma interp_eq_list_proper ts1 ts2 ts1' ts2' : | ||
737 | thunk_to_expr <$> ts1 = thunk_to_expr <$> ts1' → | ||
738 | thunk_to_expr <$> ts2 = thunk_to_expr <$> ts2' → | ||
739 | thunk_to_expr (interp_eq_list ts1 ts2) | ||
740 | = thunk_to_expr (interp_eq_list ts1' ts2'). | ||
741 | Proof. | ||
742 | intros Hts1 Hts2. rewrite /= !subst_env_alt. | ||
743 | f_equal; last first. | ||
744 | { revert ts1' ts2 ts2' Hts1 Hts2. generalize 0. | ||
745 | induction ts1; intros ? [] [] [] ??; simplify_eq/=; auto with f_equal. } | ||
746 | rewrite !map_fmap_union. f_equal; apply map_eq=> y; rewrite !lookup_fmap. | ||
747 | - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=. | ||
748 | + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy). | ||
749 | rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0. | ||
750 | rewrite lookup_fmap lookup_map_seq_0 in Hy. | ||
751 | apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1. | ||
752 | repeat destruct (_ !! _); simplify_eq/=; auto with f_equal. | ||
753 | + rewrite lookup_kmap_None in Hy. | ||
754 | apply symmetry, fmap_None, (lookup_kmap_None _). | ||
755 | intros y' ->. generalize (Hy _ eq_refl). | ||
756 | rewrite !lookup_fmap !lookup_map_seq_0. | ||
757 | apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1. | ||
758 | intros. repeat destruct (_ !! _); by simplify_eq/=. | ||
759 | - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=. | ||
760 | + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy). | ||
761 | rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0. | ||
762 | rewrite lookup_fmap lookup_map_seq_0 in Hy. | ||
763 | apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2. | ||
764 | repeat destruct (_ !! _); simplify_eq/=; auto with f_equal. | ||
765 | + rewrite lookup_kmap_None in Hy. | ||
766 | apply symmetry, fmap_None, (lookup_kmap_None _). | ||
767 | intros y' ->. generalize (Hy _ eq_refl). | ||
768 | rewrite !lookup_fmap !lookup_map_seq_0. | ||
769 | apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2. | ||
770 | intros. repeat destruct (_ !! _); by simplify_eq/=. | ||
771 | Qed. | ||
772 | |||
773 | Lemma interp_lt_list_proper ts1 ts2 ts1' ts2' : | ||
774 | thunk_to_expr <$> ts1 = thunk_to_expr <$> ts1' → | ||
775 | thunk_to_expr <$> ts2 = thunk_to_expr <$> ts2' → | ||
776 | thunk_to_expr (interp_lt_list ts1 ts2) | ||
777 | = thunk_to_expr (interp_lt_list ts1' ts2'). | ||
778 | Proof. | ||
779 | intros Hts1 Hts2. rewrite /= !subst_env_alt. | ||
780 | f_equal; last first. | ||
781 | { revert ts1' ts2 ts2' Hts1 Hts2. generalize 0. | ||
782 | induction ts1; intros ? [] [] [] ??; simplify_eq/=; auto with f_equal. } | ||
783 | rewrite !map_fmap_union. f_equal; apply map_eq=> y; rewrite !lookup_fmap. | ||
784 | - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=. | ||
785 | + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy). | ||
786 | rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0. | ||
787 | rewrite lookup_fmap lookup_map_seq_0 in Hy. | ||
788 | apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1. | ||
789 | repeat destruct (_ !! _); simplify_eq/=; auto with f_equal. | ||
790 | + rewrite lookup_kmap_None in Hy. | ||
791 | apply symmetry, fmap_None, (lookup_kmap_None _). | ||
792 | intros y' ->. generalize (Hy _ eq_refl). | ||
793 | rewrite !lookup_fmap !lookup_map_seq_0. | ||
794 | apply (f_equal (.!! y')) in Hts1. rewrite !list_lookup_fmap in Hts1. | ||
795 | intros. repeat destruct (_ !! _); by simplify_eq/=. | ||
796 | - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=. | ||
797 | + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy). | ||
798 | rewrite (lookup_kmap _) lookup_fmap lookup_map_seq_0. | ||
799 | rewrite lookup_fmap lookup_map_seq_0 in Hy. | ||
800 | apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2. | ||
801 | repeat destruct (_ !! _); simplify_eq/=; auto with f_equal. | ||
802 | + rewrite lookup_kmap_None in Hy. | ||
803 | apply symmetry, fmap_None, (lookup_kmap_None _). | ||
804 | intros y' ->. generalize (Hy _ eq_refl). | ||
805 | rewrite !lookup_fmap !lookup_map_seq_0. | ||
806 | apply (f_equal (.!! y')) in Hts2. rewrite !list_lookup_fmap in Hts2. | ||
807 | intros. repeat destruct (_ !! _); by simplify_eq/=. | ||
808 | Qed. | ||
809 | |||
810 | Lemma interp_eq_attr_proper ts1 ts2 ts1' ts2' : | ||
811 | thunk_to_expr <$> ts1 = thunk_to_expr <$> ts1' → | ||
812 | thunk_to_expr <$> ts2 = thunk_to_expr <$> ts2' → | ||
813 | thunk_to_expr (interp_eq_attr ts1 ts2) | ||
814 | = thunk_to_expr (interp_eq_attr ts1' ts2'). | ||
815 | Proof. | ||
816 | intros Hts1 Hts2. rewrite /= !subst_env_alt. | ||
817 | f_equal; last first. | ||
818 | { clear Hts2. f_equal. apply map_eq=> y. | ||
819 | rewrite !map_lookup_imap. apply (f_equal (.!! y)) in Hts1. | ||
820 | rewrite !lookup_fmap in Hts1. by repeat destruct (_ !! _). } | ||
821 | rewrite !map_fmap_union. f_equal; apply map_eq=> y; rewrite !lookup_fmap. | ||
822 | - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=. | ||
823 | + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy). | ||
824 | rewrite (lookup_kmap (String "1")) lookup_fmap. | ||
825 | rewrite lookup_fmap in Hy. | ||
826 | apply (f_equal (.!! y')) in Hts1. rewrite !lookup_fmap in Hts1. | ||
827 | repeat destruct (_ !! _); simplify_eq/=; auto with f_equal. | ||
828 | + rewrite lookup_kmap_None in Hy. | ||
829 | apply symmetry, fmap_None, (lookup_kmap_None _). | ||
830 | intros y' ->. generalize (Hy _ eq_refl). rewrite !lookup_fmap. | ||
831 | apply (f_equal (.!! y')) in Hts1. rewrite !lookup_fmap in Hts1. | ||
832 | intros. repeat destruct (_ !! _); by simplify_eq/=. | ||
833 | - destruct (kmap _ _ !! y) as [[k e]|] eqn:Hy; simplify_eq/=. | ||
834 | + apply (lookup_kmap_Some _) in Hy as (y' & -> & Hy). | ||
835 | rewrite (lookup_kmap (String "2")) lookup_fmap. | ||
836 | rewrite lookup_fmap in Hy. | ||
837 | apply (f_equal (.!! y')) in Hts2. rewrite !lookup_fmap in Hts2. | ||
838 | repeat destruct (_ !! _); simplify_eq/=; auto with f_equal. | ||
839 | + rewrite lookup_kmap_None in Hy. | ||
840 | apply symmetry, fmap_None, (lookup_kmap_None _). | ||
841 | intros y' ->. generalize (Hy _ eq_refl). rewrite !lookup_fmap. | ||
842 | apply (f_equal (.!! y')) in Hts2. rewrite !lookup_fmap in Hts2. | ||
843 | intros. repeat destruct (_ !! _); by simplify_eq/=. | ||
844 | Qed. | ||
845 | |||
846 | Opaque interp_eq_list interp_lt_list interp_eq_attr. | ||
847 | |||
848 | Lemma interp_bin_op_proper op v1 v2 : | ||
849 | val_to_expr v1 = val_to_expr v2 → | ||
850 | match interp_bin_op op v1, interp_bin_op op v2 with | ||
851 | | None, None => True | ||
852 | | Some f1, Some f2 => ∀ v1' v2', | ||
853 | val_to_expr v1' = val_to_expr v2' → | ||
854 | thunk_to_expr <$> f1 v1' = thunk_to_expr <$> f2 v2' | ||
855 | | _, _ => False | ||
856 | end. | ||
857 | Proof. | ||
858 | intros. unfold interp_bin_op, interp_eq; | ||
859 | repeat (done || case_match || simplify_eq/= || | ||
860 | destruct (option_to_eq_Some _) as [[]|]); | ||
861 | intros [] [] ?; simplify_eq/=; | ||
862 | repeat match goal with | ||
863 | | _ => done | ||
864 | | _ => progress simplify_option_eq | ||
865 | | _ => rewrite map_fmap_singleton | ||
866 | | _ => rewrite map_fmap_union | ||
867 | | _ => case_match | ||
868 | | |- context[ maybe _ ?x ] => is_var x; destruct x | ||
869 | end; auto with congruence. | ||
870 | - f_equal. by apply interp_eq_list_proper. | ||
871 | - apply (f_equal length) in H, H0. rewrite !length_fmap in H H0. congruence. | ||
872 | - apply (f_equal length) in H, H0. rewrite !length_fmap in H H0. congruence. | ||
873 | - f_equal. apply interp_eq_attr_proper. | ||
874 | + rewrite 2!map_fmap_compose in H. by simplify_eq. | ||
875 | + rewrite 2!map_fmap_compose in H0. by simplify_eq. | ||
876 | - apply (f_equal dom) in H, H0. rewrite !dom_fmap_L in H H0. congruence. | ||
877 | - apply (f_equal dom) in H, H0. rewrite !dom_fmap_L in H H0. congruence. | ||
878 | - destruct v1, v2; by simplify_eq/=. | ||
879 | - repeat destruct (option_to_eq_Some _) as [[]|]; simplify_eq/=; auto. | ||
880 | - do 3 f_equal. apply map_eq=> y. rewrite !lookup_fmap. | ||
881 | apply (f_equal (.!! y)) in H. rewrite !lookup_fmap in H. | ||
882 | repeat destruct (_ !! _) as [[]|]; naive_solver. | ||
883 | - f_equal. by apply interp_lt_list_proper. | ||
884 | - rewrite !fmap_insert /=. auto 10 with f_equal. | ||
885 | - by rewrite !fmap_app H0 H. | ||
886 | - apply (f_equal (.!! s)) in H. rewrite !lookup_fmap in H. | ||
887 | repeat destruct (_ !! _); simplify_eq/=; by f_equal. | ||
888 | - apply (f_equal (.!! s)) in H. rewrite !lookup_fmap in H. | ||
889 | repeat destruct (_ !! _); simplify_eq/=; by f_equal. | ||
890 | - rewrite !fmap_delete. congruence. | ||
891 | - assert (∀ y, is_Some (ts !! y) ↔ is_Some (ts0 !! y)) as Hx. | ||
892 | { intros y. rewrite -!(fmap_is_Some (AttrN ∘ thunk_to_expr)) -!lookup_fmap. | ||
893 | by rewrite H. } | ||
894 | apply (map_minimal_key_Some _) in H5 as [[t1 Hx1] ?], H8 as [[t2 Hx2] ?]. | ||
895 | assert (s0 = s) as -> by (apply (anti_symm attr_le); naive_solver). | ||
896 | pose proof (f_equal (.!! s) H) as Hs. rewrite !lookup_fmap in Hs. | ||
897 | rewrite !fmap_insert !fmap_empty /= !lookup_total_alt Hx1 Hx2 /=. | ||
898 | rewrite Hx1 Hx2 /= in Hs. simplify_eq/=. rewrite Hs !fmap_delete H. done. | ||
899 | - apply map_minimal_key_None in H8 as ->. | ||
900 | rewrite fmap_empty in H. by apply fmap_empty_inv in H as ->. | ||
901 | - apply map_minimal_key_None in H5 as ->. | ||
902 | rewrite fmap_empty in H. by apply symmetry, fmap_empty_inv in H as ->. | ||
903 | Qed. | ||
904 | |||
905 | Lemma interp_match_proper E1 E2 ts1 ts2 ms1 ms2 strict : | ||
906 | thunk_to_expr <$> ts1 = thunk_to_expr <$> ts2 → | ||
907 | fmap (M:=option) (subst_env E1) <$> ms1 = fmap (subst_env E2) <$> ms2 → | ||
908 | fmap (M:=gmap string) (tattr_to_attr E1) <$> interp_match ts1 ms1 strict | ||
909 | = fmap (tattr_to_attr E2) <$> interp_match ts2 ms2 strict. | ||
910 | Proof. | ||
911 | revert ms2 ts1 ts2. | ||
912 | induction ms1 as [|x m1 ms1 Hmsx IH] using map_ind; intros ms2 ts1 ts2 Hts Hms. | ||
913 | { rewrite fmap_empty in Hms. apply symmetry, fmap_empty_inv in Hms as ->. | ||
914 | rewrite /interp_match !merge_empty_r. revert ts2 Hts. | ||
915 | induction ts1 as [|x t1 ts1 Htsx IH] using map_ind; intros ts2 Hts. | ||
916 | { rewrite fmap_empty in Hts. by apply symmetry, fmap_empty_inv in Hts as ->. } | ||
917 | rewrite fmap_insert in Hts. | ||
918 | apply symmetry, fmap_insert_inv in Hts as (t2&ts2'&?&Htsx2&->&Hts); | ||
919 | last by rewrite lookup_fmap Htsx. | ||
920 | rewrite !omap_insert /=. destruct strict; simpl; | ||
921 | rewrite ?map_mapM_insert_option ?delete_notin //= ?lookup_omap ?Htsx ?Htsx2; | ||
922 | auto. } | ||
923 | rewrite fmap_insert in Hms. | ||
924 | apply symmetry, fmap_insert_inv in Hms as (m2&ms2'&?&Hmsx2&->&Hms); | ||
925 | last by rewrite lookup_fmap Hmsx. | ||
926 | pose proof (f_equal (.!! x) Hts) as Hx. rewrite !lookup_fmap in Hx. | ||
927 | destruct (ts1 !! x) as [t1|] eqn:Hts1x, (ts2 !! x) as [t2|] eqn:Hts2x; simplify_eq/=. | ||
928 | - rewrite -(insert_delete ts1 x t1) // -(insert_delete ts2 x t2) //. | ||
929 | rewrite /interp_match. erewrite <-!insert_merge by done. | ||
930 | rewrite !map_mapM_insert_option ?lookup_merge ?lookup_delete ?Hmsx ?Hmsx2 //=. | ||
931 | apply (f_equal (delete x)) in Hts. rewrite -!fmap_delete in Hts. | ||
932 | eapply IH in Hms; [|done]. rewrite /interp_match in Hms. | ||
933 | repeat destruct (map_mapM id _); simplify_eq/=; [|done..]. | ||
934 | rewrite !fmap_insert /=. auto with f_equal. | ||
935 | - rewrite /interp_match. | ||
936 | rewrite -!(insert_merge_r _ ts1 _ _ (inl <$> m1)); | ||
937 | last (rewrite Hts1x; by destruct m1). | ||
938 | rewrite -!(insert_merge_r _ ts2 _ _ (inl <$> m2)); | ||
939 | last (rewrite Hts2x; by destruct m2). | ||
940 | rewrite !map_mapM_insert_option ?lookup_merge ?Hts1x ?Hts2x ?Hmsx ?Hmsx2 //. | ||
941 | eapply IH in Hms; [|done]. rewrite /interp_match in Hms. | ||
942 | destruct m1, m2; simplify_eq/=; auto. | ||
943 | repeat destruct (map_mapM id _); simplify_eq/=; [|done..]. | ||
944 | rewrite !fmap_insert /=. auto with f_equal. | ||
945 | Qed. | ||
946 | |||
947 | Lemma mapM_interp_proper' n ts1 ts2 mvs : | ||
948 | (∀ v1 v2 mv, | ||
949 | val_to_expr v1 = val_to_expr v2 → | ||
950 | force_deep n v1 = Res mv → | ||
951 | ∃ mw m, force_deep m v2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) → | ||
952 | (∀ t1 t2 mv, | ||
953 | thunk_to_expr t1 = thunk_to_expr t2 → | ||
954 | interp_thunk n t1 = Res mv → | ||
955 | ∃ mw m, interp_thunk m t2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) → | ||
956 | thunk_to_expr <$> ts1 = thunk_to_expr <$> ts2 → | ||
957 | mapM (mbind (force_deep n) ∘ interp_thunk n) ts1 = Res mvs → | ||
958 | ∃ mws m, mapM (mbind (force_deep m) ∘ interp_thunk m) ts2 = Res mws ∧ | ||
959 | fmap (M:=list) val_to_expr <$> mvs = fmap (M:=list) val_to_expr <$> mws. | ||
960 | Proof. | ||
961 | intros force_deep_proper interp_thunk_proper Hts. | ||
962 | revert mvs. rewrite list_eq_Forall2 Forall2_fmap in Hts. | ||
963 | induction Hts as [|t1 t2 ts1 ts2 ?? IH]; intros mvs ?; simplify_res. | ||
964 | { by exists (Some []), 0. } | ||
965 | destruct (interp_thunk _ _) as [mv|] eqn:Hinterp'; simplify_res. | ||
966 | eapply interp_thunk_proper in Hinterp' | ||
967 | as (mw & m1 & Hinterp1 & Hw); [|by eauto..]. | ||
968 | destruct mv as [v|], mw as [w|]; simplify_res; last first. | ||
969 | { exists None, m1. by rewrite /= Hinterp1. } | ||
970 | destruct (force_deep _ _) as [mv'|] eqn:Hforce; simplify_res. | ||
971 | eapply force_deep_proper in Hforce as (mw' & m2 & Hforce2 & Hw'); last done. | ||
972 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
973 | { exists None, (m1 `max` m2). | ||
974 | rewrite (interp_thunk_le Hinterp1) /=; last lia. | ||
975 | rewrite (force_deep_le Hforce2) /=; last lia. done. } | ||
976 | destruct (mapM _ _) as [mvs'|] eqn:?; simplify_res. | ||
977 | destruct (IH _ eq_refl) as (mws & m3 & Hmap3 & ?). | ||
978 | exists ((w' ::.) <$> mws), (S (m1 `max` m2 `max` m3)). | ||
979 | rewrite (interp_thunk_le Hinterp1) /=; last lia. | ||
980 | rewrite (force_deep_le Hforce2) /=; last lia. | ||
981 | rewrite (mapM_interp_le Hmap3) /=; last lia. split; [by destruct mws|]. | ||
982 | destruct mvs', mws; simplify_res; auto 10 with f_equal. | ||
983 | Qed. | ||
984 | |||
985 | Lemma force_deep_proper n v1 v2 mv : | ||
986 | val_to_expr v1 = val_to_expr v2 → | ||
987 | force_deep n v1 = Res mv → | ||
988 | ∃ mw m, force_deep m v2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw | ||
989 | with interp_proper n E1 E2 e1 e2 mv : | ||
990 | subst_env E1 e1 = subst_env E2 e2 → | ||
991 | interp n E1 e1 = Res mv → | ||
992 | ∃ mw m, interp m E2 e2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw | ||
993 | with interp_thunk_proper n t1 t2 mv : | ||
994 | thunk_to_expr t1 = thunk_to_expr t2 → | ||
995 | interp_thunk n t1 = Res mv → | ||
996 | ∃ mw m, interp_thunk m t2 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw | ||
997 | with interp_app_proper n v1 v2 t1' t2' mv : | ||
998 | val_to_expr v1 = val_to_expr v2 → | ||
999 | thunk_to_expr t1' = thunk_to_expr t2' → | ||
1000 | interp_app n v1 t1' = Res mv → | ||
1001 | ∃ mw m, interp_app m v2 t2' = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw. | ||
1002 | Proof. | ||
1003 | (* force_deep_proper *) | ||
1004 | - destruct n as [|n]; [done|]. | ||
1005 | intros Hv Hinterp. rewrite force_deep_S /force_deep1 in Hinterp. | ||
1006 | destruct v1 as [| | |ts1|ts1], v2 as [| | |ts2|ts2]; simplify_res. | ||
1007 | { eexists _, 1; split; [by rewrite force_deep_S|]. done. } | ||
1008 | { eexists _, 1; split; [by rewrite force_deep_S|]. simpl. auto with f_equal. } | ||
1009 | { eexists _, 1; split; [by rewrite force_deep_S|]. simpl. auto with f_equal. } | ||
1010 | { destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_res. | ||
1011 | eapply mapM_interp_proper' in Hmap as (mws & m & Hmap & Hmvs); [|by eauto..]. | ||
1012 | exists (VList ∘ fmap Forced <$> mws), (S m). | ||
1013 | rewrite force_deep_S /= Hmap. split; [done|]. | ||
1014 | destruct mvs, mws; simplify_eq/=; do 2 f_equal. | ||
1015 | rewrite list_eq_Forall2 Forall2_fmap in Hmvs. | ||
1016 | by rewrite list_eq_Forall2 !Forall2_fmap. } | ||
1017 | destruct (map_mapM_sorted _ _ _) as [mvs|] eqn:Hmap; simplify_res. | ||
1018 | assert (∃ mws m, | ||
1019 | map_mapM_sorted attr_le | ||
1020 | (mbind (force_deep m) ∘ interp_thunk m) ts2 = Res mws ∧ | ||
1021 | fmap (M:=gmap _) val_to_expr <$> mvs = fmap (M:=gmap _) val_to_expr <$> mws) | ||
1022 | as (mws & m & Hmap' & Hmvs); last first. | ||
1023 | { exists (VAttr ∘ fmap Forced <$> mws), (S m). | ||
1024 | rewrite force_deep_S /= Hmap'. split; [done|]. | ||
1025 | destruct mvs, mws; simplify_eq/=; do 2 f_equal. | ||
1026 | apply map_eq=> x. rewrite !lookup_fmap. | ||
1027 | apply (f_equal (.!! x)) in Hmvs. rewrite !lookup_fmap in Hmvs. | ||
1028 | repeat destruct (_ !! x); simplify_res; auto with f_equal. } | ||
1029 | revert ts2 mvs Hmap Hv. induction ts1 as [|x t1 ts1 Hx1 ? IH] | ||
1030 | using (map_sorted_ind attr_le); intros ts2' mvs Hmap Hts. | ||
1031 | { exists (Some ∅), 0. rewrite fmap_empty in Hts. | ||
1032 | apply symmetry, fmap_empty_inv in Hts as ->. | ||
1033 | rewrite map_mapM_sorted_empty in Hmap; simplify_res. | ||
1034 | by rewrite map_mapM_sorted_empty. } | ||
1035 | rewrite map_mapM_sorted_insert //= in Hmap. rewrite fmap_insert in Hts. | ||
1036 | apply symmetry, fmap_insert_inv in Hts as (t2 & ts2 & Ht & ? & -> & Hts); | ||
1037 | simplify_eq/=; last by rewrite lookup_fmap Hx1. | ||
1038 | assert (∀ j, is_Some (ts2 !! j) → attr_le x j). | ||
1039 | { intros j. rewrite -(fmap_is_Some (AttrN ∘ thunk_to_expr)). | ||
1040 | rewrite -lookup_fmap -Hts lookup_fmap fmap_is_Some. auto. } | ||
1041 | destruct (interp_thunk _ _) as [mv|] eqn:Hinterp'; simplify_res. | ||
1042 | eapply interp_thunk_proper in Hinterp' | ||
1043 | as (mw & m1 & Hinterp1 & Hw); [|by eauto..]. | ||
1044 | destruct mv as [v|], mw as [w|]; simplify_res; last first. | ||
1045 | { exists None, m1. by rewrite map_mapM_sorted_insert //= Hinterp1. } | ||
1046 | destruct (force_deep _ _) as [mv'|] eqn:Hforce; simplify_res. | ||
1047 | eapply force_deep_proper in Hforce as (mw' & m2 & Hforce2 & Hw'); last done. | ||
1048 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
1049 | { exists None, (m1 `max` m2). rewrite map_mapM_sorted_insert //=. | ||
1050 | rewrite (interp_thunk_le Hinterp1) /=; last lia. | ||
1051 | rewrite (force_deep_le Hforce2) /=; last lia. done. } | ||
1052 | destruct (map_mapM_sorted _ _ _) as [mvs'|] eqn:?; simplify_res. | ||
1053 | eapply IH in Hts as (mws & m3 & Hmap3 & ?); last done. | ||
1054 | exists (<[x:=w']> <$> mws), (S (m1 `max` m2 `max` m3)). | ||
1055 | rewrite map_mapM_sorted_insert //=. | ||
1056 | rewrite (interp_thunk_le Hinterp1) /=; last lia. | ||
1057 | rewrite (force_deep_le Hforce2) /=; last lia. | ||
1058 | rewrite (map_mapM_interp_le Hmap3) /=; last lia. | ||
1059 | destruct mvs' as [vs'|], mws as [ws'|]; simplify_res; last done. | ||
1060 | split; [done|]. rewrite !fmap_insert. auto 10 with f_equal. | ||
1061 | (* interp_proper *) | ||
1062 | - destruct n as [|n]; [done|]. intros Hsubst Hinterp. | ||
1063 | rewrite 2!subst_env_eq in Hsubst. | ||
1064 | rewrite interp_S in Hinterp. destruct e1, e2; simplify_res; try done. | ||
1065 | + (* ELit *) | ||
1066 | case_guard; simplify_res. | ||
1067 | * eexists (Some (VLit _ ltac:(done))), 1. by rewrite interp_lit. | ||
1068 | * exists None, 1. split; [|done]. rewrite interp_S /=. by case_guard. | ||
1069 | + (* EId *) | ||
1070 | assert (∀ (mke : option (kind * expr)) (E : env) x, | ||
1071 | prod_map id thunk_to_expr <$> | ||
1072 | union_kinded (E !! x) (prod_map id (Thunk ∅) <$> mke) | ||
1073 | = union_kinded (prod_map id thunk_to_expr <$> E !! x) mke) as HE. | ||
1074 | { intros mke' E x. destruct (E !! _) as [[[] ?]|], mke' as [[[] ?]|]; | ||
1075 | simplify_eq/=; rewrite ?subst_env_empty //. } | ||
1076 | rewrite -!HE {HE} in H. | ||
1077 | destruct (union_kinded (E1 !! _) _) as [[k1 t1]|], | ||
1078 | (union_kinded (E2 !! _) _) as [[k2 t2]|] eqn:HE2; simplify_res; last first. | ||
1079 | { exists None, (S n). rewrite interp_S /=. by rewrite HE2. } | ||
1080 | eapply interp_thunk_proper | ||
1081 | in Hinterp as (mw & m & Hinterp & ?); [|by eauto..]. | ||
1082 | exists mw, (S (n `max` m)). split; [|done]. rewrite interp_S /= HE2 /=. | ||
1083 | eauto using interp_thunk_le with lia. | ||
1084 | + (* EAbs *) eexists (Some (VClo _ _ _)), 1; split; [by rewrite interp_S|]. | ||
1085 | simpl. auto with f_equal. | ||
1086 | + (* EAbsMatch *) | ||
1087 | eexists (Some (VCloMatch _ _ _ _)), 1; split; [by rewrite interp_S|]. | ||
1088 | simpl. auto with f_equal. | ||
1089 | + (* EApp *) | ||
1090 | destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp'; simplify_eq/=. | ||
1091 | eapply interp_proper in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done. | ||
1092 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
1093 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
1094 | destruct (interp_app n _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
1095 | eapply (interp_app_proper _ _ _ _ (Thunk _ _)) in Hinterp' | ||
1096 | as (mw & m2 & Hinterp2 & ?); [|done..]. | ||
1097 | exists mw, (S (m1 `max` m2)). rewrite interp_S /=. | ||
1098 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1099 | rewrite (interp_app_le Hinterp2) /=; last lia. done. | ||
1100 | + (* ESeq *) | ||
1101 | destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp'; simplify_eq/=. | ||
1102 | eapply interp_proper in Hinterp' as (mw1 & m1 & Hinterp1 & ?); last done. | ||
1103 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
1104 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
1105 | destruct μ0; simplify_res. | ||
1106 | { eapply interp_proper in Hinterp as (w2 & m2 & Hinterp2 & ?); last done. | ||
1107 | exists w2, (S (m1 `max` m2)). rewrite interp_S /=. | ||
1108 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1109 | rewrite (interp_le Hinterp2) /=; last lia. done. } | ||
1110 | destruct (force_deep _ _) as [mv'|] eqn:Hforce; simplify_res. | ||
1111 | eapply force_deep_proper in Hforce as (mw' & m2 & Hforce & ?); last done. | ||
1112 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
1113 | { exists None, (S (m1 `max` m2)). rewrite interp_S /=. | ||
1114 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1115 | rewrite (force_deep_le Hforce) /=; last lia. done. } | ||
1116 | eapply interp_proper in Hinterp as (w2 & m3 & Hinterp3 & ?); last done. | ||
1117 | exists w2, (S (m1 `max` m2 `max` m3)). rewrite interp_S /=. | ||
1118 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1119 | rewrite (force_deep_le Hforce) /=; last lia. | ||
1120 | rewrite (interp_le Hinterp3) /=; last lia. done. | ||
1121 | + (* EList *) | ||
1122 | eexists (Some (VList _)), 1; rewrite interp_S /=; split; [done|]. | ||
1123 | do 2 f_equal. revert es0 Hsubst. | ||
1124 | induction es; intros [] ?; simplify_eq/=; f_equal/=; auto. | ||
1125 | + (* EAttr *) | ||
1126 | eexists (Some (VAttr _)), 1; rewrite interp_S /=; split; [done|]. | ||
1127 | do 2 f_equal. apply map_eq=> x. rewrite !lookup_fmap. | ||
1128 | pose proof (f_equal (.!! x) Hsubst) as Hx. rewrite !lookup_fmap in Hx. | ||
1129 | destruct (αs !! x) as [[[]]|], (αs0 !! x) as [[[]]|]; | ||
1130 | simplify_eq/=; do 2 f_equal; auto. | ||
1131 | apply indirects_env_proper, Hx. by rewrite !tattr_to_attr_from_attr. | ||
1132 | + (* ELetAttr *) | ||
1133 | destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_eq/=. | ||
1134 | eapply interp_proper in Hinterp' as (mw' & m1 & Hinterp1 & ?); last done. | ||
1135 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
1136 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
1137 | destruct (maybe VAttr _) eqn:Hattr; simplify_res; last first. | ||
1138 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
1139 | by assert (maybe VAttr w' = None) as -> by (by destruct v', w'). } | ||
1140 | destruct v', w'; simplify_res. | ||
1141 | eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & ?); | ||
1142 | [|by apply subst_env_union_fmap_proper]. | ||
1143 | exists mw, (S (m1 `max` m2)). rewrite interp_S /=. | ||
1144 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1145 | rewrite (interp_le Hinterp2) /=; last lia. done. | ||
1146 | + (* EBinOp *) | ||
1147 | destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp1; simplify_res. | ||
1148 | eapply interp_proper in Hinterp1 as (mw1 & m1 & Hinterp1 & Hw1); last done. | ||
1149 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
1150 | { exists None. exists (S m1). by rewrite interp_S /= Hinterp1. } | ||
1151 | apply (interp_bin_op_proper op0) in Hw1. | ||
1152 | destruct (interp_bin_op _ v1) as [f|] eqn:Hop1, | ||
1153 | (interp_bin_op _ w1) as [g|] eqn:Hop2; simplify_res; try done; last first. | ||
1154 | { exists None. exists (S m1). by rewrite interp_S /= Hinterp1 /= Hop2. } | ||
1155 | destruct (interp n _ e1_2) as [mv2|] eqn:Hinterp2; simplify_res. | ||
1156 | eapply interp_proper in Hinterp2 as (mw2 & m2 & Hinterp2 & Hw2); last done. | ||
1157 | destruct mv2 as [v2|], mw2 as [w2|]; simplify_res; last first. | ||
1158 | { exists None. exists (S (m1 `max` m2)). rewrite interp_S /=. | ||
1159 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1160 | rewrite Hop2 /= (interp_le Hinterp2) /=; last lia. done. } | ||
1161 | apply Hw1 in Hw2. | ||
1162 | destruct (f v2) as [t|] eqn:Hf, | ||
1163 | (g w2) as [t'|] eqn:Hg; simplify_res; last first. | ||
1164 | { exists None. exists (S (m1 `max` m2)). rewrite interp_S /=. | ||
1165 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1166 | rewrite Hop2 /= (interp_le Hinterp2) /=; last lia. by rewrite Hg. } | ||
1167 | eapply interp_thunk_proper in Hinterp | ||
1168 | as (mw & m3 & Hforce3 & Hw); [|by eauto..]. | ||
1169 | exists mw, (S (m1 `max` m2 `max` m3)). rewrite interp_S /=. split; [|done]. | ||
1170 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1171 | rewrite Hop2 /= (interp_le Hinterp2) /=; last lia. | ||
1172 | rewrite Hg /=. eauto using interp_thunk_le with lia. | ||
1173 | + (* EIf *) | ||
1174 | destruct (interp n _ e1_1) as [mv1|] eqn:Hinterp1; simplify_res. | ||
1175 | eapply interp_proper in Hinterp1 as (mw1 & m1 & Hinterp1 & Hw1); last done. | ||
1176 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
1177 | { exists None. exists (S m1). by rewrite interp_S /= Hinterp1. } | ||
1178 | destruct (maybe_VLit _ ≫= maybe LitBool) as [b|] eqn:Hbool; | ||
1179 | simplify_res; last first. | ||
1180 | { exists None. exists (S m1). rewrite interp_S /= Hinterp1 /=. | ||
1181 | destruct v1, w1; repeat destruct select base_lit; naive_solver. } | ||
1182 | eapply (interp_proper _ _ _ _ (if b then _ else _)) in Hinterp | ||
1183 | as (mw & m2 & Hinterp & Hw); last by destruct b. | ||
1184 | exists mw, (S (m1 `max` m2)). split; [|done]. rewrite interp_S /=. | ||
1185 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1186 | assert (maybe_VLit w1 ≫= maybe LitBool = Some b) as ->. | ||
1187 | { destruct v1, w1; repeat destruct select base_lit; naive_solver. } | ||
1188 | rewrite /=. eauto using interp_le with lia. | ||
1189 | (* interp_thunk_proper *) | ||
1190 | - destruct n as [|n]; [done|]. | ||
1191 | intros Ht Hinterp. rewrite interp_thunk_S in Hinterp. | ||
1192 | destruct t1 as [v1|E1 e1|x1 E1 tαs1], t2 as [v2|E2 e2|x2 E2 tαs2]; simplify_res. | ||
1193 | + exists (Some v2), 1. rewrite interp_thunk_S /=. auto with f_equal. | ||
1194 | + destruct (interp_val_to_expr E2 e2 v1) as (w & m & ? & ?); first done. | ||
1195 | exists (Some w), (S m); simpl; auto with f_equal. | ||
1196 | + by destruct v1. | ||
1197 | + exists (Some v2), 1; split; [done|]; simpl. | ||
1198 | symmetry. eauto using interp_val_to_expr_Res. | ||
1199 | + eapply interp_proper in Hinterp as (mw & m & ? & ?); eauto. | ||
1200 | exists mw, (S m). eauto. | ||
1201 | + assert (∃ αs1, e1 = ESelect (EAttr αs1) x2 ∧ | ||
1202 | attr_subst_env E1 <$> αs1 = tattr_to_attr E2 <$> tαs2) as (αs1 & -> & Hαs). | ||
1203 | { repeat match goal with | ||
1204 | | H : subst_env _ ?e = _ |- _ => | ||
1205 | rewrite subst_env_eq in H; destruct e; simplify_eq; [] | ||
1206 | end; eauto. } | ||
1207 | clear Ht. destruct n as [|n]; [done|]. | ||
1208 | rewrite !interp_S /= in Hinterp. | ||
1209 | (* without [in Hinterp at 2 3] the termination checker loops *) | ||
1210 | destruct n as [|n'] in Hinterp at 2 3; [done|]. | ||
1211 | rewrite !interp_S /= lookup_fmap in Hinterp. | ||
1212 | pose proof (f_equal (.!! x2) Hαs) as Hx. rewrite !lookup_fmap in Hx. | ||
1213 | destruct (αs1 !! x2) as [[[] e1]|], | ||
1214 | (tαs2 !! x2) as [[e2|t2]|] eqn:Hx2; simplify_res. | ||
1215 | * rewrite -tattr_to_attr_from_attr in Hαs. | ||
1216 | destruct n as [|n]; [done|]. rewrite interp_thunk_S in Hinterp. | ||
1217 | eapply interp_proper in Hinterp as (mw & m & Hinterp & ?); | ||
1218 | last by apply indirects_env_proper. | ||
1219 | exists mw, (S m). by rewrite interp_thunk_S /= Hx2. | ||
1220 | * eapply interp_thunk_proper in Hinterp | ||
1221 | as (mw & m & Hinterp & ?); last done. | ||
1222 | exists mw, (S m). rewrite interp_thunk_S /= Hx2. done. | ||
1223 | * exists None, (S n). by rewrite interp_thunk_S /= Hx2. | ||
1224 | + by destruct v2. | ||
1225 | + assert (∃ αs2, e2 = ESelect (EAttr αs2) x1 ∧ | ||
1226 | attr_subst_env E2 <$> αs2 = tattr_to_attr E1 <$> tαs1) as (αs2 & -> & Hαs). | ||
1227 | { repeat match goal with | ||
1228 | | H : _ = subst_env _ ?e |- _ => | ||
1229 | rewrite subst_env_eq in H; destruct e; simplify_eq; [] | ||
1230 | end; eauto. } | ||
1231 | clear Ht. | ||
1232 | pose proof (f_equal (.!! x1) Hαs) as Hx. rewrite !lookup_fmap in Hx. | ||
1233 | destruct (tαs1 !! x1) as [[e1|t1]|], | ||
1234 | (αs2 !! x1) as [[[] e2]|] eqn:Hx2; simplify_res. | ||
1235 | * rewrite -tattr_to_attr_from_attr in Hαs. | ||
1236 | eapply interp_proper in Hinterp as (mw & m & Hinterp & ?); | ||
1237 | last by apply indirects_env_proper. | ||
1238 | exists mw, (S (S (S m))). rewrite interp_thunk_S /= !interp_S /=. | ||
1239 | rewrite lookup_fmap Hx2 /= interp_thunk_S /=. done. | ||
1240 | * apply (interp_thunk_proper _ _ (Thunk E2 e2)) | ||
1241 | in Hinterp as (mw & m & Hinterp & ?); last done. | ||
1242 | destruct m as [|m]; [done|]. | ||
1243 | exists mw, (S (S (S m))). rewrite interp_thunk_S /= !interp_S /=. | ||
1244 | rewrite lookup_fmap Hx2 /= interp_thunk_S /=. done. | ||
1245 | * exists None, (S (S (S n))). rewrite interp_thunk_S /= !interp_S /=. | ||
1246 | rewrite lookup_fmap Hx2 /=. done. | ||
1247 | + pose proof (f_equal (.!! x2) Ht) as Hx. rewrite !lookup_fmap in Hx. | ||
1248 | destruct (tαs1 !! x2) as [[e1|t1]|] eqn:Hx1, | ||
1249 | (tαs2 !! _) as [[e2|t2]|] eqn:Hx2; simplify_res. | ||
1250 | * eapply interp_proper in Hinterp | ||
1251 | as (mw & m & Hinterp & ?); [|by apply indirects_env_proper]. | ||
1252 | exists mw, (S m). rewrite interp_thunk_S /= Hx2. done. | ||
1253 | * eapply interp_thunk_proper in Hinterp as (mw & m & Hinterp & ?); [|done]. | ||
1254 | exists mw, (S m). rewrite interp_thunk_S /= Hx2. done. | ||
1255 | * exists None, 1. by rewrite interp_thunk_S /= Hx2. | ||
1256 | (* interp_app_proper *) | ||
1257 | - destruct n as [|n]; [done|]. | ||
1258 | intros Hv Ht Hinterp. rewrite interp_app_S /= in Hinterp. | ||
1259 | destruct v1, v2; simplify_res. | ||
1260 | + (* VLit *) by eexists None, 1. | ||
1261 | + (* VClo *) | ||
1262 | eapply interp_proper in Hinterp as (mw & m & Hinterp' & ?); | ||
1263 | last by eapply subst_env_insert_proper. | ||
1264 | eexists _, (S m). rewrite interp_app_S /= Hinterp'. done. | ||
1265 | + (* VCloMatch *) | ||
1266 | destruct (interp_thunk n t1') as [mv1|] eqn:Hthunk; simplify_res. | ||
1267 | eapply interp_thunk_proper in Hthunk as (mw1 & m1 & Hthunk & Hw); [|by eauto..]. | ||
1268 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
1269 | { exists None, (S m1). split; [|done]. | ||
1270 | rewrite interp_app_S /= Hthunk /=. done. } | ||
1271 | destruct (maybe VAttr v1) as [ts1|] eqn:?; simplify_res; last first. | ||
1272 | { exists None, (S m1). split; [|done]. | ||
1273 | rewrite interp_app_S /= Hthunk /=. destruct v1, w1; naive_solver. } | ||
1274 | destruct v1, w1; simplify_eq/=. | ||
1275 | rewrite 2!map_fmap_compose in Hw. apply (inj _) in Hw. | ||
1276 | eapply (interp_match_proper _ _ _ _ _ _ strict0) in Hw; last done. | ||
1277 | destruct (interp_match ts1 _ _) as [tαs1|] eqn:Hmatch1, | ||
1278 | (interp_match ts0 _ _) as [tαs2|] eqn:Hmatch2; | ||
1279 | simplify_res; try done; last first. | ||
1280 | { exists None, (S m1). split; [|done]. | ||
1281 | rewrite interp_app_S /= Hthunk /= Hmatch2. done. } | ||
1282 | eapply interp_proper in Hinterp as (mw & m2 & Hinterp & ?); last first. | ||
1283 | { by apply indirects_env_proper. } | ||
1284 | exists mw, (S (m1 `max` m2)). split; [|done]. | ||
1285 | rewrite interp_app_S /=. | ||
1286 | rewrite (interp_thunk_le Hthunk) /=; last lia. | ||
1287 | rewrite Hmatch2 /=. eauto using interp_le with lia. | ||
1288 | + (* VList *) by eexists None, 1. | ||
1289 | + (* VAttr *) | ||
1290 | pose proof (f_equal (.!! "__functor") Hv) as Htf. | ||
1291 | rewrite !lookup_fmap /= in Htf. | ||
1292 | destruct (ts !! _) as [e|] eqn:Hfunc, (ts0 !! _) as [e'|] eqn:Hfunc'; | ||
1293 | simplify_res; last first. | ||
1294 | { exists None, 1. by rewrite interp_app_S /= Hfunc'. } | ||
1295 | destruct (interp_thunk _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
1296 | eapply interp_thunk_proper in Hinterp' | ||
1297 | as (mw' & m1 & Hinterp1 & Hw'); [|by eauto..]. | ||
1298 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
1299 | { exists None, (S m1). by rewrite interp_app_S /= Hfunc' /= Hinterp1. } | ||
1300 | destruct (interp_app _ _ _) as [mv'|] eqn:Happ; simplify_res. | ||
1301 | eapply (interp_app_proper _ _ _ _ (Forced (VAttr _))) in Happ | ||
1302 | as (mw' & m2 & Happ2 & ?); [|done|by rewrite /= Hv]. | ||
1303 | destruct mv', mw'; simplify_res; last first. | ||
1304 | { exists None, (S (m1 `max` m2)). rewrite interp_app_S /= Hfunc' /=. | ||
1305 | rewrite (interp_thunk_le Hinterp1) /=; last lia. | ||
1306 | rewrite (interp_app_le Happ2) /=; last lia. done. } | ||
1307 | eapply interp_app_proper in Hinterp as (mw' & m3 & Happ3 & ?); [|done..]. | ||
1308 | exists mw', (S (m1 `max` m2 `max` m3)). rewrite interp_app_S /= Hfunc' /=. | ||
1309 | rewrite (interp_thunk_le Hinterp1) /=; last lia. | ||
1310 | rewrite (interp_app_le Happ2) /=; last lia. | ||
1311 | rewrite (interp_app_le Happ3) /=; last lia. done. | ||
1312 | Qed. | ||
1313 | |||
1314 | Lemma mapM_interp_proper n ts1 ts2 mvs : | ||
1315 | thunk_to_expr <$> ts1 = thunk_to_expr <$> ts2 → | ||
1316 | mapM (mbind (force_deep n) ∘ interp_thunk n) ts1 = Res mvs → | ||
1317 | ∃ mws m, mapM (mbind (force_deep m) ∘ interp_thunk m) ts2 = Res mws ∧ | ||
1318 | fmap (M:=list) val_to_expr <$> mvs = fmap (M:=list) val_to_expr <$> mws. | ||
1319 | Proof. eauto using mapM_interp_proper', force_deep_proper, interp_thunk_proper. Qed. | ||
1320 | |||
1321 | Lemma interp_thunk_as_interp n t mv : | ||
1322 | interp_thunk n t = Res mv → | ||
1323 | ∃ mw m, interp m ∅ (thunk_to_expr t) = Res mw ∧ | ||
1324 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
1325 | Proof. | ||
1326 | revert t mv. induction n as [|n IH]; intros t mv Hinterp; [done|]. | ||
1327 | rewrite interp_thunk_S in Hinterp. destruct t as [v|E e|x E tαs]; simplify_res. | ||
1328 | { destruct (interp_empty_val_to_expr v) as (w & m & Hinterp & ?). | ||
1329 | exists (Some w), m; simpl; auto using f_equal. } | ||
1330 | { eapply interp_proper, Hinterp. by rewrite subst_env_empty. } | ||
1331 | destruct (tαs !! x) as [[e|t]|] eqn:Hx; simplify_res. | ||
1332 | - eapply interp_proper in Hinterp as (mw & m & Hinterp & ?); | ||
1333 | last apply subst_env_indirects_env. | ||
1334 | exists mw, (S (S m)). rewrite !interp_S /=. | ||
1335 | rewrite !lookup_fmap Hx /= interp_thunk_S /=. done. | ||
1336 | - apply IH in Hinterp as (mw & m & Hinterp & ?). | ||
1337 | exists mw, (S (S m)). rewrite !interp_S /=. | ||
1338 | rewrite !lookup_fmap Hx /= interp_thunk_S //=. | ||
1339 | - exists None, (S (S n)). rewrite !interp_S /=. | ||
1340 | by rewrite !lookup_fmap Hx /=. | ||
1341 | Qed. | ||
1342 | |||
1343 | Lemma interp_as_interp_thunk n t mv : | ||
1344 | interp n ∅ (thunk_to_expr t) = Res mv → | ||
1345 | ∃ mw m, interp_thunk m t = Res mw ∧ | ||
1346 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
1347 | Proof. | ||
1348 | revert t mv. induction (lt_wf n) as [[|n] _ IH]; intros t mv Hinterp; [done|]. | ||
1349 | destruct t as [v|E e|x E tαs]; simplify_res. | ||
1350 | { apply interp_empty_val_to_expr_Res in Hinterp. by exists (Some v), 1. } | ||
1351 | { eapply (interp_proper _ _ E) in Hinterp as (mw & m & Hinterp & ?); | ||
1352 | [|by rewrite subst_env_empty]. | ||
1353 | exists mw, (S m). by rewrite interp_thunk_S /=. } | ||
1354 | destruct n as [|n]; [done|]. rewrite !interp_S /= in Hinterp. | ||
1355 | rewrite !lookup_fmap in Hinterp. | ||
1356 | destruct (tαs !! x) as [[e|t]|] eqn:Hx; simplify_res. | ||
1357 | - rewrite interp_thunk_S /= in Hinterp. | ||
1358 | eapply interp_proper in Hinterp as (mw & m & Hinterp & ?); | ||
1359 | last apply symmetry, subst_env_indirects_env. | ||
1360 | exists mw, (S m). rewrite interp_thunk_S /= Hx. done. | ||
1361 | - rewrite interp_thunk_S /= in Hinterp. | ||
1362 | eapply IH in Hinterp as (mw & m & Hinterp & ?); last lia. | ||
1363 | exists mw, (S m). rewrite !interp_thunk_S /= Hx. done. | ||
1364 | - exists None, (S n). rewrite !interp_thunk_S /= Hx. done. | ||
1365 | Qed. | ||
1366 | |||
1367 | Lemma delayed_interp n e e' mv : | ||
1368 | interp n ∅ e' = Res mv → | ||
1369 | e =D=> e' → | ||
1370 | ∃ m, interp m ∅ e = Res mv. | ||
1371 | Proof. | ||
1372 | intros Hinterp Hdel. revert n mv Hinterp. induction Hdel; intros n mv Hinterp. | ||
1373 | - by eauto. | ||
1374 | - apply IHHdel in Hinterp as [m Hinterp]. | ||
1375 | exists (S (S m)). rewrite interp_S /= lookup_empty left_id_L /=. | ||
1376 | by rewrite interp_thunk_S /=. | ||
1377 | - destruct n as [|n]; [done|]. rewrite interp_S /= in Hinterp. | ||
1378 | destruct (interp _ _ e1') as [mv1|] eqn:Hinterp1; simplify_res. | ||
1379 | apply IHHdel1 in Hinterp1 as [m1 Hinterp1]. | ||
1380 | destruct mv1 as [v1|]; simplify_res; last first. | ||
1381 | { exists (S m1). by rewrite interp_S /= Hinterp1. } | ||
1382 | destruct (interp_bin_op op v1) as [f|] eqn:Hf; simplify_res; last first. | ||
1383 | { exists (S m1). by rewrite interp_S /= Hinterp1 /= Hf. } | ||
1384 | destruct (interp _ _ e2') as [mv2|] eqn:Hinterp2; simplify_res. | ||
1385 | apply IHHdel2 in Hinterp2 as [m2 Hinterp2]. exists (S (n `max` m1 `max` m2)). | ||
1386 | rewrite interp_S /= (interp_le Hinterp1); last lia. | ||
1387 | rewrite /= Hf /= (interp_le Hinterp2); last lia. | ||
1388 | destruct mv2; simplify_res; [|done]. | ||
1389 | destruct (f _); simplify_res; [|done]. | ||
1390 | eauto using interp_thunk_le with lia. | ||
1391 | - destruct n as [|n]; [done|]. rewrite interp_S /= in Hinterp. | ||
1392 | destruct (interp _ _ e1') as [mv1|] eqn:Hinterp1; simplify_res. | ||
1393 | apply IHHdel1 in Hinterp1 as [m1 Hinterp1]. | ||
1394 | destruct mv1 as [v1|]; simplify_res; last first. | ||
1395 | { exists (S m1). by rewrite interp_S /= Hinterp1. } | ||
1396 | destruct (maybe_VLit v1 ≫= maybe LitBool) as [[]|] eqn: Hbool; simplify_res. | ||
1397 | + apply IHHdel2 in Hinterp as [m2 Hinterp2]. exists (S (m1 `max` m2)). | ||
1398 | rewrite interp_S /= (interp_le Hinterp1); last lia. | ||
1399 | rewrite /= Hbool /=. eauto using interp_le with lia. | ||
1400 | + apply IHHdel3 in Hinterp as [m3 Hinterp3]. exists (S (m1 `max` m3)). | ||
1401 | rewrite interp_S /= (interp_le Hinterp1); last lia. | ||
1402 | rewrite /= Hbool /=. eauto using interp_le with lia. | ||
1403 | + exists (S m1). rewrite interp_S /= Hinterp1 /= Hbool. done. | ||
1404 | Qed. | ||
1405 | |||
1406 | Lemma interp_subst_abs n x e1 e2 mv : | ||
1407 | interp n ∅ (subst {[x:=(ABS, e2)]} e1) = Res mv → | ||
1408 | ∃ mw m, interp m (<[x:=(ABS, Thunk ∅ e2)]> ∅) e1 = Res mw ∧ | ||
1409 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
1410 | Proof. | ||
1411 | apply interp_proper. by rewrite subst_env_empty subst_abs_as_subst_env. | ||
1412 | Qed. | ||
1413 | |||
1414 | Lemma interp_subst_indirects n e αs mv : | ||
1415 | interp n ∅ (subst (indirects αs) e) = Res mv → | ||
1416 | ∃ mw m, | ||
1417 | interp m (indirects_env ∅ (attr_to_tattr ∅ <$> αs)) e = Res mw ∧ | ||
1418 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
1419 | Proof. | ||
1420 | apply interp_proper. rewrite subst_env_empty. rewrite subst_env_alt. | ||
1421 | f_equal. apply map_eq=> x. rewrite !lookup_fmap. | ||
1422 | destruct (αs !! x) eqn:?; do 2 f_equal/=; | ||
1423 | rewrite /indirects /indirects_env right_id_L !map_lookup_imap | ||
1424 | !lookup_fmap !Heqo //=. | ||
1425 | rewrite tattr_to_attr_from_attr_empty //. | ||
1426 | Qed. | ||
1427 | |||
1428 | Lemma interp_subst_fmap k n e es mv : | ||
1429 | interp n ∅ (subst ((k,.) <$> es) e) = Res mv → | ||
1430 | ∃ mw m, interp m ((k,.) ∘ Thunk ∅ <$> es) e = Res mw ∧ | ||
1431 | val_to_expr <$> mv = val_to_expr <$> mw. | ||
1432 | Proof. | ||
1433 | apply interp_proper. rewrite subst_env_empty. rewrite subst_env_alt. | ||
1434 | f_equal. apply map_eq=> x. rewrite !lookup_fmap. | ||
1435 | destruct (es !! x) as [d|]; do 2 f_equal/=. by rewrite subst_env_empty. | ||
1436 | Qed. | ||
1437 | |||
1438 | Lemma final_interp μ e : | ||
1439 | final μ e → | ||
1440 | ∃ w m, interp m ∅ e = mret w ∧ e = val_to_expr w. | ||
1441 | Proof. | ||
1442 | revert μ. induction e; intros μ'; intros Hfinal; try by inv Hfinal. | ||
1443 | - inv Hfinal. eexists (VLit _ _), 1. by rewrite interp_lit /=. | ||
1444 | - eexists (VClo _ _ _), 1. rewrite interp_S /=. split; [done|]. | ||
1445 | by rewrite /= subst_env_empty. | ||
1446 | - eexists (VCloMatch _ _ _ _), 1. rewrite interp_S /=. split; [done|]. | ||
1447 | rewrite /= subst_env_empty. f_equal. | ||
1448 | apply map_eq=> x. rewrite lookup_fmap. | ||
1449 | destruct (ms !! x) as [[]|]; do 2 f_equal/=. by rewrite subst_env_empty. | ||
1450 | - eexists (VList _), 1. rewrite interp_S /=. split; [done|]. f_equal. clear. | ||
1451 | induction es; f_equal/=; [|done]. | ||
1452 | by rewrite /= subst_env_empty. | ||
1453 | - eexists (VAttr _), 1. rewrite interp_S /=. split; [done|]. | ||
1454 | f_equal. apply map_eq=> x. | ||
1455 | assert (no_recs αs) by (by inv Hfinal). | ||
1456 | rewrite from_attr_no_recs // !lookup_fmap. | ||
1457 | destruct (_ !! _) as [[]|] eqn:?; f_equal/=. | ||
1458 | f_equal; eauto using no_recs_lookup, subst_env_empty. | ||
1459 | Qed. | ||
1460 | |||
1461 | Lemma final_force_deep' v : | ||
1462 | final DEEP (val_to_expr v) → | ||
1463 | ∃ w m, force_deep m v = mret w ∧ val_to_expr v = val_to_expr w. | ||
1464 | Proof. | ||
1465 | intros Hfinal. remember (val_to_expr v) as e eqn:He. | ||
1466 | revert v He. induction e; intros [] ?; simplify_eq/=; inv Hfinal. | ||
1467 | - (* VLit *) eexists (VLit _ _), 1. by rewrite force_deep_S. | ||
1468 | - (* VClo *) | ||
1469 | eexists (VClo _ _ _), 1. by rewrite force_deep_S. | ||
1470 | - (* VCloMatch *) | ||
1471 | eexists (VCloMatch _ _ _ _), 1. by rewrite force_deep_S. | ||
1472 | - (* VList *) | ||
1473 | assert (∃ vs m, mapM (mbind (force_deep m) ∘ interp_thunk m) ts = mret vs ∧ | ||
1474 | val_to_expr <$> vs = thunk_to_expr <$> ts) | ||
1475 | as (vs & m & Hmap & Hvs); last first. | ||
1476 | { exists (VList (Forced <$> vs)), (S m). rewrite force_deep_S /= Hmap /=. | ||
1477 | split; [done|]. f_equal. rewrite -Hvs. | ||
1478 | clear. by induction vs; by f_equal/=. } | ||
1479 | rewrite Forall_fmap in H1. induction H1 as [|t ts Ht ? IH]; simplify_eq/=. | ||
1480 | { by exists [], 0. } | ||
1481 | apply Forall_cons in H as [IHt IHts]. | ||
1482 | destruct IH as (ws & m1 & Hinterp1 & ?); simplify_eq/=; [done|]. clear IHts. | ||
1483 | destruct (final_interp DEEP (thunk_to_expr t)) | ||
1484 | as (v' & m & Hinterp & ?); [done|]. | ||
1485 | apply interp_as_interp_thunk in Hinterp | ||
1486 | as ([v''|] & m' & Hinterp & ?); simplify_res. | ||
1487 | destruct (IHt Ht v'') as (w & m'' & Hforce & ?); [congruence|]. | ||
1488 | exists (w :: ws), (m1 `max` m' `max` m''); csimpl. | ||
1489 | rewrite (interp_thunk_le Hinterp) /=; last lia. | ||
1490 | rewrite (force_deep_le Hforce) /=; last lia. | ||
1491 | rewrite (mapM_interp_le Hinterp1) /=; last lia. auto with f_equal. | ||
1492 | - (* VAttr *) clear H1. assert (∃ vs m, | ||
1493 | map_mapM_sorted attr_le | ||
1494 | (mbind (force_deep m) ∘ interp_thunk m) ts = mret vs ∧ | ||
1495 | val_to_expr <$> vs = thunk_to_expr <$> ts) | ||
1496 | as (vs & m & Hmap & Hvs); last first. | ||
1497 | { exists (VAttr (Forced <$> vs)), (S m). rewrite force_deep_S /= Hmap /=. | ||
1498 | split; [done|]. rewrite 2!map_fmap_compose -Hvs. f_equal. | ||
1499 | apply map_eq=> x. rewrite !lookup_fmap. by destruct (vs !! x). } | ||
1500 | induction ts as [|x t ts Hx ? IH] using (map_sorted_ind attr_le). | ||
1501 | { exists ∅, 0. by rewrite map_mapM_sorted_empty. } | ||
1502 | rewrite fmap_insert /= in H, H2. | ||
1503 | apply map_Forall_insert in H as [IHt IHts]; last by rewrite lookup_fmap Hx. | ||
1504 | apply map_Forall_insert in H2 as [Ht Hts]; last by rewrite lookup_fmap Hx. | ||
1505 | apply IH in IHts as (ws & m1 & Hinterp1 & ?); clear IH; simplify_eq/=; last done. | ||
1506 | destruct (final_interp DEEP (thunk_to_expr t)) | ||
1507 | as (v' & m & Hinterp & ?); [done|]. | ||
1508 | apply interp_as_interp_thunk in Hinterp | ||
1509 | as ([v''|] & m' & Hinterp & ?); simplify_res. | ||
1510 | destruct (IHt Ht v'') as (w & m'' & Hforce & ?); [congruence|]. | ||
1511 | exists (<[x:=w]> ws), (m1 `max` m' `max` m''). | ||
1512 | rewrite fmap_insert map_mapM_sorted_insert //=. | ||
1513 | rewrite (interp_thunk_le Hinterp) /=; last lia. | ||
1514 | rewrite (force_deep_le Hforce) /=; last lia. | ||
1515 | rewrite (map_mapM_interp_le Hinterp1) /=; last lia. | ||
1516 | rewrite fmap_insert. auto with f_equal. | ||
1517 | Qed. | ||
1518 | |||
1519 | Lemma interp_step μ e1 e2 : | ||
1520 | e1 -{μ}-> e2 → | ||
1521 | (∀ n mv, | ||
1522 | ¬final SHALLOW e1 → | ||
1523 | interp n ∅ e2 = Res mv → | ||
1524 | exists mw m, interp m ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) ∧ | ||
1525 | (∀ n v1 v2 mv, | ||
1526 | μ = DEEP → | ||
1527 | e1 = val_to_expr v1 → | ||
1528 | e2 = val_to_expr v2 → | ||
1529 | force_deep n v2 = Res mv → | ||
1530 | exists mw m, force_deep m v1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw). | ||
1531 | Proof. | ||
1532 | intros Hstep. induction Hstep; inv_step. | ||
1533 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1534 | apply interp_subst_abs in Hinterp as (mw & [|m] & Hinterp & Hv); simplify_eq/=. | ||
1535 | exists mw, (S (S (S m))). split; [|done]. | ||
1536 | rewrite interp_S /= interp_app_S /= /= !interp_S /=. | ||
1537 | rewrite -!interp_S /=. rewrite (interp_le Hinterp); last lia. done. | ||
1538 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1539 | destruct n as [|n]; simplify_eq/=. apply interp_match_Some_2 in H0. | ||
1540 | apply interp_subst_indirects in Hinterp as (mw & m & Hinterp & ?). | ||
1541 | exists mw, (S (S (S (S m)))); split; [|done]. | ||
1542 | rewrite !interp_S /= interp_app_S /= interp_thunk_S /= (interp_S m) /=. | ||
1543 | rewrite from_attr_no_recs // map_fmap_compose H0 /=. | ||
1544 | eauto using interp_le with lia. | ||
1545 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1546 | destruct n as [|[|[|n]]]; simplify_eq/=. | ||
1547 | rewrite !interp_S /= -!interp_S in Hinterp. | ||
1548 | destruct (interp _ _ e1) as [mw|] eqn:Hinterp'; simplify_res. | ||
1549 | destruct mw as [w|]; simplify_res; last first. | ||
1550 | { exists None, (S (S (S (S n)))). split; [|done]. | ||
1551 | rewrite 2!interp_S /= interp_app_S /=. | ||
1552 | rewrite from_attr_no_recs // lookup_fmap H0 /=. | ||
1553 | rewrite interp_thunk_S /= Hinterp'. done. } | ||
1554 | destruct (interp_app _ _ _) as [mv'|] eqn:Happ; simplify_res. | ||
1555 | eapply (interp_app_proper _ _ _ _ | ||
1556 | (Forced (VAttr (Thunk ∅ ∘ attr_expr <$> αs)))) | ||
1557 | in Happ as (mw' & m1 & Happ1 & Hw); [|done|]; last first. | ||
1558 | { rewrite /= subst_env_eq /=. f_equal. | ||
1559 | apply map_eq=> y. rewrite !lookup_fmap. | ||
1560 | destruct (αs !! y) as [[]|] eqn:?; do 2 f_equal/=; eauto using no_recs_lookup. } | ||
1561 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
1562 | { exists None, (S (S (S (S (n `max` m1))))). split; [|done]. | ||
1563 | rewrite 2!interp_S /= interp_app_S /=. | ||
1564 | rewrite from_attr_no_recs // lookup_fmap H0 /=. | ||
1565 | rewrite interp_thunk_S /= (interp_le Hinterp') /=; last lia. | ||
1566 | rewrite (interp_app_le Happ1); last lia. done. } | ||
1567 | eapply interp_app_proper in Hinterp as (mw & m2 & ? & Hinterp); [|done..]. | ||
1568 | exists mw, (S (S (S (S (n `max` m1 `max` m2))))). split; [|done]. | ||
1569 | rewrite !interp_S /= interp_app_S /=. | ||
1570 | rewrite from_attr_no_recs // lookup_fmap H0 /=. | ||
1571 | rewrite interp_thunk_S /= (interp_le Hinterp') /=; last lia. | ||
1572 | rewrite (interp_app_le Happ1) /=; last lia. | ||
1573 | eauto using interp_app_le with lia. | ||
1574 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1575 | destruct (final_interp μ' e1) as (v & m & Hinterp' & ->); first done. | ||
1576 | destruct μ'. | ||
1577 | { exists mv, (S (n `max` m)). rewrite interp_S /=. | ||
1578 | rewrite (interp_le Hinterp) /=; last lia. | ||
1579 | by rewrite (interp_le Hinterp') /=; last lia. } | ||
1580 | destruct (final_force_deep' v) as (w & m' & Hforce & ?); first done. | ||
1581 | exists mv, (S (n `max` m `max` m')). rewrite interp_S /=. | ||
1582 | rewrite (interp_le Hinterp) /=; last lia. | ||
1583 | rewrite (interp_le Hinterp') /=; last lia. | ||
1584 | by rewrite (force_deep_le Hforce) /=; last lia. | ||
1585 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1586 | rewrite map_fmap_compose in Hinterp. | ||
1587 | apply interp_subst_fmap in Hinterp as (mw & [|m] & Hinterp & Hv); simplify_eq/=. | ||
1588 | rewrite map_fmap_compose in Hinterp. | ||
1589 | exists mw, (S (S m)). rewrite !interp_S /= -interp_S. | ||
1590 | rewrite from_attr_no_recs // right_id_L map_fmap_compose. done. | ||
1591 | - split; last first. | ||
1592 | { intros n [] v2 mv _ Hαs; simplify_eq/=. by destruct H. } | ||
1593 | intros n mv _ Hinterp. destruct n as [|n]; [done|]. | ||
1594 | rewrite interp_S /= in Hinterp; simplify_res. | ||
1595 | eexists _, 1; split; [by rewrite interp_S|]. | ||
1596 | do 2 f_equal/=. apply map_eq=> x /=. rewrite !lookup_fmap. | ||
1597 | destruct (αs !! x) as [[[] ?]|]; do 2 f_equal/=. | ||
1598 | by rewrite subst_env_indirects_env_attr_to_tattr_empty subst_env_empty. | ||
1599 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1600 | apply final_interp in H as (v1 & m1 & Hinterp1 & ->). | ||
1601 | pose proof H1 as Hsem. apply interp_bin_op_Some_2 in H1 as [f Hf]. | ||
1602 | eapply final_interp in H0 as (v2 & m2 & Hinterp2 & ->). | ||
1603 | eapply interp_bin_op_Some_Some_2 in H2 as (t3 & Hfv & Hdel); [|done..]. | ||
1604 | eapply delayed_interp in Hinterp as (m3 & Hinterp); [|done]. | ||
1605 | apply interp_as_interp_thunk in Hinterp as (mw & m & Hinterp3 & ?). | ||
1606 | exists mw, (S (m `max` m1 `max` m2)). split; [|done]. rewrite interp_S /=. | ||
1607 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1608 | rewrite Hf /= (interp_le Hinterp2) /=; last lia. | ||
1609 | rewrite Hfv /= (interp_thunk_le Hinterp3); last lia. done. | ||
1610 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1611 | exists mv, (S (S n)). rewrite !interp_S /= -interp_S. | ||
1612 | eauto using interp_le with lia. | ||
1613 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1614 | exists mv, (S (S n)). rewrite !interp_S /= lookup_empty /=. done. | ||
1615 | - split; [intros ?? []; constructor; by eauto|]. | ||
1616 | intros n [] [] mv _ Hts Hts' Hforce; simplify_eq. | ||
1617 | destruct n as [|n]; [done|rewrite force_deep_S /= in Hforce]. | ||
1618 | destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_eq/=. | ||
1619 | destruct IHHstep as [IH1 IH2]. | ||
1620 | apply symmetry, fmap_app_inv in Hts | ||
1621 | as (ts1 & [|t1 ts1'] & ? & ? & ?); simplify_eq/=. | ||
1622 | apply symmetry, fmap_app_inv in Hts' | ||
1623 | as (ts2 & [|t2 ts2'] & Hts & ? & ?); simplify_eq/=. | ||
1624 | assert (∃ mws m, | ||
1625 | mapM (mbind (force_deep m) ∘ interp_thunk m) (ts1 ++ t1 :: ts1') = Res mws ∧ | ||
1626 | fmap (M:=list) val_to_expr <$> mvs = fmap (M:=list) val_to_expr <$> mws) | ||
1627 | as (mws & m & Hmap' & Hmvs); last first. | ||
1628 | { exists (VList ∘ fmap Forced <$> mws), (S m). rewrite force_deep_S /= Hmap'. | ||
1629 | split; [done|]. | ||
1630 | destruct mvs as [vs|], mws as [ws|]; simplify_eq/=; do 2 f_equal. | ||
1631 | rewrite list_eq_Forall2 Forall2_fmap in Hmvs. | ||
1632 | by rewrite list_eq_Forall2 !Forall2_fmap. } | ||
1633 | rewrite mapM_res_app in Hmap. | ||
1634 | destruct (mapM _ ts2) as [mvs1|] eqn:Hmap1; simplify_res. | ||
1635 | eapply mapM_interp_proper in Hmap1 as (mws1 & m1 & Hmap1 & ?); [|done]. | ||
1636 | destruct mvs1 as [vs1|], mws1 as [ws1|]; simplify_res; last first. | ||
1637 | { exists None, m1. by rewrite mapM_res_app Hmap1. } | ||
1638 | destruct (interp_thunk n t2) as [mw|] eqn:Hinterp; simplify_res. | ||
1639 | apply interp_thunk_as_interp in Hinterp as (mw' & m & Hinterp & Hmw'). | ||
1640 | destruct (default mfail (force_deep n <$> mw)) | ||
1641 | as [mu|] eqn:Hforce; simplify_res. | ||
1642 | destruct (step_any_shallow _ _ _ Hstep) as [|Hfinal1]. | ||
1643 | + (* SHALLOW *) | ||
1644 | apply IH1 in Hinterp as (mw'' & m' & Hinterp & Hmw''); | ||
1645 | [|by eauto using step_not_final]. | ||
1646 | apply interp_as_interp_thunk in Hinterp as (mw''' & m2 & Hinterp & ?). | ||
1647 | destruct mw as [w|], mw', mw'', mw''' as [w'''|]; simplify_res; last first. | ||
1648 | { exists None, (m1 `max` m2). rewrite mapM_res_app. | ||
1649 | rewrite (mapM_interp_le Hmap1) /=; last lia. | ||
1650 | rewrite (interp_thunk_le Hinterp) /=; last lia. done. } | ||
1651 | eapply (force_deep_proper _ _ w''') | ||
1652 | in Hforce as (mu' & m3 & Hforce & ?); last congruence. | ||
1653 | destruct mu as [u|], mu' as [u'|]; simplify_res; last first. | ||
1654 | { exists None, (m1 `max` m2 `max` m3). rewrite mapM_res_app. | ||
1655 | rewrite (mapM_interp_le Hmap1) /=; last lia. | ||
1656 | rewrite (interp_thunk_le Hinterp) /=; last lia. | ||
1657 | rewrite (force_deep_le Hforce) /=; last lia. done. } | ||
1658 | destruct (mapM _ ts2') as [mvs2|] eqn:Hmap2; simplify_res. | ||
1659 | eapply mapM_interp_proper in Hmap2 as (mws2 & m4 & Hmap2 & ?); [|done]. | ||
1660 | exists ((ws1 ++.) ∘ (u' ::.) <$> mws2), (m1 `max` m2 `max` m3 `max` m4). | ||
1661 | rewrite mapM_res_app. | ||
1662 | rewrite (mapM_interp_le Hmap1) /=; last lia. | ||
1663 | rewrite (interp_thunk_le Hinterp) /=; last lia. | ||
1664 | rewrite (force_deep_le Hforce) /=; last lia. | ||
1665 | rewrite (mapM_interp_le Hmap2) /=; last lia. split; [by destruct mws2|]. | ||
1666 | destruct mvs2, mws2; simplify_res; f_equal. rewrite !fmap_app !fmap_cons. | ||
1667 | congruence. | ||
1668 | + (* DEEP *) | ||
1669 | apply step_final_shallow in Hstep as Hfinal2; last done. | ||
1670 | apply final_interp in Hfinal1 as (w1 & m2 & Hinterpt1 & ?). | ||
1671 | apply interp_as_interp_thunk in Hinterpt1 as (mw'' & m3 & Hinterpt1 & ?). | ||
1672 | apply final_interp in Hfinal2 as (w2' & m4 & Hinterpt2 & ?). | ||
1673 | eapply interp_agree in Hinterp; last apply Hinterpt2. | ||
1674 | destruct mw as [w2|], mw'' as [w2''|]; simplify_res. | ||
1675 | eapply IH2 in Hforce as (mu' & m5 & Hforce & ?); [|by auto with congruence..]. | ||
1676 | eapply (force_deep_proper _ _ w2'') | ||
1677 | in Hforce as (mu'' & m6 & Hforce & ?); last congruence. | ||
1678 | destruct mu as [u|], mu' as [u'|], mu'' as [u''|]; simplify_res; last first. | ||
1679 | { exists None, (m1 `max` m3 `max` m6). rewrite mapM_res_app. | ||
1680 | rewrite (mapM_interp_le Hmap1) /=; last lia. | ||
1681 | rewrite (interp_thunk_le Hinterpt1) /=; last lia. | ||
1682 | rewrite (force_deep_le Hforce) /=; last lia. done. } | ||
1683 | destruct (mapM _ ts2') as [mvs2|] eqn:Hmap2; simplify_res. | ||
1684 | eapply mapM_interp_proper in Hmap2 as (mws2 & m7 & Hmap2 & ?); [|done]. | ||
1685 | exists ((ws1 ++.) ∘ (u'' ::.) <$> mws2), (m1 `max` m3 `max` m6 `max` m7). | ||
1686 | rewrite mapM_res_app. | ||
1687 | rewrite (mapM_interp_le Hmap1) /=; last lia. | ||
1688 | rewrite (interp_thunk_le Hinterpt1) /=; last lia. | ||
1689 | rewrite (force_deep_le Hforce) /=; last lia. | ||
1690 | rewrite (mapM_interp_le Hmap2) /=; last lia. split; [by destruct mws2|]. | ||
1691 | destruct mvs2, mws2; simplify_res; f_equal. rewrite !fmap_app !fmap_cons. | ||
1692 | congruence. | ||
1693 | - split; [intros ?? []; constructor; by eauto using no_recs_insert|]. | ||
1694 | intros n [] [] mv _ Hts Hts' Hforce; simplify_eq. | ||
1695 | destruct n as [|n]; [done|rewrite force_deep_S /= in Hforce]. | ||
1696 | destruct (map_mapM_sorted _ _ _) as [mvs|] eqn:Hmap; simplify_eq/=. | ||
1697 | destruct IHHstep as [IH1 IH2]. | ||
1698 | apply symmetry, fmap_insert_inv in Hts | ||
1699 | as (t1 & ts1 & ? & Hx1 & ? & ?); simplify_eq/=; last done. | ||
1700 | apply symmetry, fmap_insert_inv in Hts' as (t2 & ts2 & ? & Hx2 & ? & Hts); | ||
1701 | simplify_eq/=; last by rewrite lookup_fmap Hx1. | ||
1702 | assert (∃ mws m, | ||
1703 | map_mapM_sorted attr_le (mbind (force_deep m) ∘ interp_thunk m) | ||
1704 | (<[x:=t1]> ts1) = Res mws ∧ | ||
1705 | fmap (M:=gmap _) val_to_expr <$> mvs = fmap (M:=gmap _) val_to_expr <$> mws) | ||
1706 | as (mws & m & Hmap' & Hmvs); last first. | ||
1707 | { exists (VAttr ∘ fmap Forced <$> mws), (S m). rewrite force_deep_S /= Hmap'. | ||
1708 | split; [done|]. | ||
1709 | destruct mvs as [vs|], mws as [ws|]; simplify_eq/=; do 2 f_equal. | ||
1710 | apply map_eq=> y. rewrite !lookup_fmap. | ||
1711 | apply (f_equal (.!! y)) in Hmvs. rewrite !lookup_fmap in Hmvs. | ||
1712 | destruct (vs !! _), (ws !! _); simplify_eq/=; auto with f_equal. } | ||
1713 | destruct (step_any_shallow _ _ _ Hstep) as [|Hfinal]. | ||
1714 | + (* SHALLOW *) assert (map_Forall2 (λ _ t1 t2, ∀ n mv, | ||
1715 | interp n ∅ (thunk_to_expr t2) = Res mv → | ||
1716 | ∃ mw m, interp m ∅ (thunk_to_expr t1) = Res mw ∧ | ||
1717 | val_to_expr <$> mv = val_to_expr <$> mw) | ||
1718 | (<[x:=t1]> ts1) (<[x:=t2]> ts2)) as IHts. | ||
1719 | { apply map_Forall2_insert_2; first by eauto using step_not_final. | ||
1720 | intros y. apply (f_equal (.!! y)) in Hts. rewrite !lookup_fmap in Hts. | ||
1721 | destruct (ts1 !! y), (ts2 !! y); simplify_eq/=; constructor. | ||
1722 | rewrite -Hts; eauto. } | ||
1723 | revert IHts Hmap. generalize (<[x:=t1]> ts1) (<[x:=t2]> ts2). clear. | ||
1724 | intros ts1. revert n mvs. | ||
1725 | induction ts1 as [|x t1 ts1 ?? IH] using (map_sorted_ind attr_le); | ||
1726 | intros n mvs ts2' IHts Hmap. | ||
1727 | { apply map_Forall2_empty_inv_l in IHts as ->. | ||
1728 | rewrite map_mapM_sorted_empty in Hmap; simplify_res. | ||
1729 | by exists (Some ∅), 1. } | ||
1730 | apply map_Forall2_insert_inv_l in IHts | ||
1731 | as (t2 & ts2 & -> & ? & IHt & IHts); simplify_eq/=; last done. | ||
1732 | assert (∀ j, is_Some (ts2 !! j) → attr_le x j). | ||
1733 | { apply map_Forall2_dom_L in IHts. intros j. | ||
1734 | rewrite -elem_of_dom -IHts elem_of_dom. auto. } | ||
1735 | rewrite map_mapM_sorted_insert //= in Hmap. | ||
1736 | destruct (interp_thunk _ _) as [mv|] eqn:Hinterp; simplify_res. | ||
1737 | assert (∃ mw m, interp_thunk m t1 = Res mw ∧ | ||
1738 | val_to_expr <$> mv = val_to_expr <$> mw) as (mw & m1 & Hinterp1 & ?). | ||
1739 | { apply interp_thunk_as_interp in Hinterp as (mw & m & Hinterp & ?). | ||
1740 | apply IHt in Hinterp as (mw' & m' & Hinterp & ?). | ||
1741 | eapply interp_as_interp_thunk in Hinterp as (mw'' & m'' & Hinterp & ?). | ||
1742 | exists mw'', m''. eauto with congruence. } | ||
1743 | destruct mv as [v|], mw as [w|]; simplify_res; last first. | ||
1744 | { exists None, m1. split; [|done]. rewrite map_mapM_sorted_insert //=. | ||
1745 | by rewrite Hinterp1. } | ||
1746 | destruct (force_deep _ _) as [mv|] eqn:Hforce; simplify_res. | ||
1747 | eapply force_deep_proper in Hforce as (mw & m2 & Hforce' & ?); last done. | ||
1748 | destruct mv as [v'|], mw as [w'|]; simplify_res; last first. | ||
1749 | { exists None, (m1 `max` m2). split; [|done]. | ||
1750 | rewrite map_mapM_sorted_insert //=. | ||
1751 | rewrite (interp_thunk_le Hinterp1) /=; last lia. | ||
1752 | rewrite (force_deep_le Hforce') /=; last lia. done. } | ||
1753 | destruct (map_mapM_sorted _ _ _) as [mvs'|] eqn:Hmap'; simplify_res. | ||
1754 | apply IH in Hmap' as (mws & m3 & Hmap3 & ?); last done. | ||
1755 | exists (fmap <[x:=w']> mws), (m1 `max` m2 `max` m3). | ||
1756 | rewrite map_mapM_sorted_insert //=. | ||
1757 | rewrite (interp_thunk_le Hinterp1) /=; last lia. | ||
1758 | rewrite (force_deep_le Hforce') /=; last lia. | ||
1759 | rewrite (map_mapM_interp_le Hmap3) /=; last lia. | ||
1760 | destruct mvs', mws; simplify_res; last done. | ||
1761 | rewrite !fmap_insert. auto with f_equal. | ||
1762 | + (* DEEP *) | ||
1763 | assert (map_Forall2 (λ _ t1 t2, | ||
1764 | thunk_to_expr t1 = thunk_to_expr t2 ∨ | ||
1765 | ∃ v1 v2, | ||
1766 | thunk_to_expr t1 = val_to_expr v1 ∧ | ||
1767 | thunk_to_expr t2 = val_to_expr v2 ∧ | ||
1768 | ∀ n mv, | ||
1769 | force_deep n v2 = Res mv → | ||
1770 | ∃ mw m, force_deep m v1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw) | ||
1771 | (<[x:=t1]> ts1) (<[x:=t2]> ts2)) as IHts. | ||
1772 | { apply map_Forall2_insert_2; last first. | ||
1773 | { intros y. apply (f_equal (.!! y)) in Hts. rewrite !lookup_fmap in Hts. | ||
1774 | destruct (ts1 !! y), (ts2 !! y); simplify_eq/=; constructor; eauto. } | ||
1775 | assert (final SHALLOW (thunk_to_expr t2)) | ||
1776 | as (v2 & m2 & Hinterp2 & Ht2)%final_interp | ||
1777 | by eauto using step_final_shallow. | ||
1778 | apply final_interp in Hfinal as (v1 & m1 & Hinterp1 & Ht1); eauto 10. } | ||
1779 | revert IHts Hmap. generalize (<[x:=t1]> ts1) (<[x:=t2]> ts2). clear. | ||
1780 | intros ts1. revert n mvs. | ||
1781 | induction ts1 as [|x t1 ts1 ?? IH] using (map_sorted_ind attr_le); | ||
1782 | intros n mvs ts2' IHts Hmap. | ||
1783 | { apply map_Forall2_empty_inv_l in IHts as ->. | ||
1784 | rewrite map_mapM_sorted_empty in Hmap; simplify_res. | ||
1785 | by exists (Some ∅), 1. } | ||
1786 | apply map_Forall2_insert_inv_l in IHts | ||
1787 | as (t2 & ts2 & -> & ? & IHt & IHts); simplify_eq/=; last done. | ||
1788 | assert (∀ j, is_Some (ts2 !! j) → attr_le x j). | ||
1789 | { apply map_Forall2_dom_L in IHts. intros j. | ||
1790 | rewrite -elem_of_dom -IHts elem_of_dom. auto. } | ||
1791 | rewrite map_mapM_sorted_insert //= in Hmap. | ||
1792 | destruct (interp_thunk n t2 ≫= force_deep n) | ||
1793 | as [mv|] eqn:Hinterp; simplify_res. | ||
1794 | assert (∃ mw m, interp_thunk m t1 ≫= force_deep m = Res mw ∧ | ||
1795 | val_to_expr <$> mv = val_to_expr <$> mw) as (mw & m1 & Hinterp1 & ?). | ||
1796 | { destruct (interp_thunk _ _) as [mv'|] eqn:Hthunk; simplify_res. | ||
1797 | destruct IHt as [|(v1 & v2 & Ht1 & Ht2 & IHt)]. | ||
1798 | * eapply interp_thunk_proper in Hthunk | ||
1799 | as (mw' & m1 & Hthunk1 & ?); last done. | ||
1800 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
1801 | { exists None, m1. by rewrite Hthunk1. } | ||
1802 | eapply force_deep_proper in Hinterp | ||
1803 | as (mw & m2 & Hforce2 & ?); last done. | ||
1804 | exists mw, (m1 `max` m2). split; [|done]. | ||
1805 | rewrite (interp_thunk_le Hthunk1) /=; last lia. | ||
1806 | eauto using force_deep_le with lia. | ||
1807 | * destruct (interp_empty_val_to_expr v1) as (v1' & m1 & Hinterp1 & ?). | ||
1808 | rewrite -Ht1 in Hinterp1. | ||
1809 | eapply interp_as_interp_thunk in Hinterp1 | ||
1810 | as ([v1''|] & m1' & Hthunk1 & ?); simplify_res. | ||
1811 | eapply (interp_thunk_proper _ _ (Forced v2)) in Hthunk | ||
1812 | as (mw2 & m2 & Hthunk2 & ?); simplify_res; [|done]. | ||
1813 | destruct m2 as [|m2]; [done|]. | ||
1814 | rewrite interp_thunk_S in Hthunk2; simplify_res. | ||
1815 | destruct mv' as [v2'|]; simplify_res. | ||
1816 | eapply force_deep_proper in Hinterp | ||
1817 | as (mv' & m2' & Hforce2 & ?); last done. | ||
1818 | eapply IHt in Hforce2 as (mw' & m2'' & Hforce2 & ?). | ||
1819 | eapply (force_deep_proper _ _ v1'') in Hforce2 | ||
1820 | as (mw'' & m2''' & Hforce2 & ?); last congruence. | ||
1821 | exists mw'', (m1' `max` m2'''). | ||
1822 | rewrite (interp_thunk_le Hthunk1) /=; last lia. | ||
1823 | rewrite (force_deep_le Hforce2) /=; last lia. auto with congruence. } | ||
1824 | destruct mv as [v|], mw as [w|]; simplify_res; last first. | ||
1825 | { exists None, m1. split; [|done]. rewrite map_mapM_sorted_insert //=. | ||
1826 | by rewrite Hinterp1. } | ||
1827 | destruct (map_mapM_sorted _ _ _) as [mvs'|] eqn:Hmap'; simplify_res. | ||
1828 | apply IH in Hmap' as (mws & m2 & Hmap2 & ?); last done. | ||
1829 | exists (fmap <[x:=w]> mws), (m1 `max` m2). | ||
1830 | rewrite map_mapM_sorted_insert //=. | ||
1831 | destruct (interp_thunk m1 t1) as [[]|] eqn:Hinterp'; simplify_res. | ||
1832 | rewrite (interp_thunk_le Hinterp') /=; last lia. | ||
1833 | rewrite (force_deep_le Hinterp1) /=; last lia. | ||
1834 | rewrite (map_mapM_interp_le Hmap2) /=; last lia. | ||
1835 | destruct mvs', mws; simplify_res; last done. | ||
1836 | rewrite !fmap_insert. auto with f_equal. | ||
1837 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1838 | destruct n as [|n]; simplify_eq/=. | ||
1839 | rewrite interp_S /= in Hinterp. | ||
1840 | destruct (interp n ∅ e') as [mv'|] eqn:Hinterp'; simplify_res. | ||
1841 | apply IHHstep in Hinterp' | ||
1842 | as (mw' & m1 & Hinterp1 & ?); last by eauto using step_not_final. | ||
1843 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
1844 | { exists None, (S m1). split; [|done]. by rewrite interp_S /= Hinterp1. } | ||
1845 | eapply interp_app_proper in Hinterp as (mw & m2 & Happ2 & ?); [|done..]. | ||
1846 | exists mw, (S (m1 `max` m2)). rewrite interp_S /=. | ||
1847 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1848 | rewrite (interp_app_le Happ2) /=; last lia. done. | ||
1849 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1850 | destruct n as [|[|[|n]]]; simplify_eq/=. | ||
1851 | rewrite !interp_S /= interp_app_S /= interp_thunk_S /= in Hinterp. | ||
1852 | destruct (interp n ∅ e') as [mv'|] eqn:Hinterp'; simplify_res. | ||
1853 | apply IHHstep in Hinterp' | ||
1854 | as (mw' & m1 & Hinterp1 & Hw'); last by eauto using step_not_final. | ||
1855 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
1856 | { exists None, (S (S (S m1))). split; [|done]. | ||
1857 | rewrite !interp_S /= interp_app_S /= interp_thunk_S /=. | ||
1858 | by rewrite Hinterp1. } | ||
1859 | destruct (maybe VAttr v') as [ts|] eqn:?; simplify_res; last first. | ||
1860 | { exists None, (S (S (S m1))). split; [|done]. | ||
1861 | rewrite !interp_S /= interp_app_S /= interp_thunk_S /= Hinterp1 /=. | ||
1862 | assert (maybe VAttr w' = None) as ->; [|done]. | ||
1863 | destruct v', w'; naive_solver. } | ||
1864 | destruct v', w'; simplify_eq/=. | ||
1865 | rewrite 2!map_fmap_compose in Hw'. apply (inj _) in Hw'. | ||
1866 | eapply (interp_match_proper ∅ ∅ _ _ ms ms strict) in Hw'; [|done]. | ||
1867 | destruct (interp_match ts _ strict) as [tαs1|] eqn:Hmatch1, | ||
1868 | (interp_match ts1 _ strict) as [tαs2|] eqn:Hmatch2; | ||
1869 | simplify_res; try done; last first. | ||
1870 | { exists None, (S (S (S m1))). split; [|done]. | ||
1871 | rewrite !interp_S /= interp_app_S /= interp_thunk_S /=. | ||
1872 | rewrite Hinterp1 /= Hmatch2. done. } | ||
1873 | eapply interp_proper in Hinterp | ||
1874 | as (mw & m2 & Hinterp & ?); last first. | ||
1875 | { by apply indirects_env_proper. } | ||
1876 | exists mw, (S (S (S (m1 `max` m2)))). split; [|done]. | ||
1877 | rewrite !interp_S /= interp_app_S /= interp_thunk_S /=. | ||
1878 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1879 | rewrite Hmatch2 /=. eauto using interp_le with lia. | ||
1880 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1881 | destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
1882 | destruct (interp n _ e') as [mv'|] eqn:Hinterp'; simplify_eq/=. | ||
1883 | destruct (step_any_shallow μ e e') as [|Hfinal]; first done. | ||
1884 | + apply IHHstep in Hinterp' | ||
1885 | as (mw' & m & Hinterp' & Hw); last by eauto using step_not_final. | ||
1886 | destruct mv' as [v|], mw' as [w'|]; simplify_res; last first. | ||
1887 | { exists None, (S m). by rewrite interp_S /= Hinterp'. } | ||
1888 | destruct μ; simplify_res. | ||
1889 | { exists mv, (S (n `max` m)). rewrite interp_S /=. | ||
1890 | rewrite (interp_le Hinterp') /=; last lia. | ||
1891 | rewrite (interp_le Hinterp) /=; last lia. done. } | ||
1892 | destruct (force_deep n v) as [mv'|] eqn:Hforce; simplify_res. | ||
1893 | eapply force_deep_proper | ||
1894 | in Hforce as (mw' & m2 & Hforce2 & ?); last done. | ||
1895 | exists mv, (S (n `max` m `max` m2)). split; [|done]. rewrite interp_S /=. | ||
1896 | rewrite (interp_le Hinterp') /=; last lia. | ||
1897 | rewrite (force_deep_le Hforce2) /=; last lia. | ||
1898 | destruct mv', mw'; simplify_res; eauto using interp_le with lia. | ||
1899 | + destruct μ; [by odestruct step_not_final|]. | ||
1900 | assert (final SHALLOW e') as (w & m & Hinterp'' & ->)%final_interp | ||
1901 | by eauto using step_final_shallow. | ||
1902 | apply interp_empty_val_to_expr_Res in Hinterp'. | ||
1903 | destruct mv' as [v|]; simplify_res. | ||
1904 | destruct (force_deep n v) as [mv'|] eqn:Hforce; simplify_res. | ||
1905 | apply final_interp in Hfinal as (w' & m' & Hinterp''' & ->). | ||
1906 | eapply IHHstep in Hforce as (mw' & m'' & Hforce' & ?); [|done..]. | ||
1907 | exists mv, (S (n `max` m' `max` m'')). rewrite interp_S /=. | ||
1908 | rewrite (interp_le Hinterp''') /=; last lia. | ||
1909 | rewrite (force_deep_le Hforce') /=; last lia. | ||
1910 | destruct mv', mw'; simplify_res; eauto using interp_le with lia. | ||
1911 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1912 | destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
1913 | destruct (interp n _ _) as [mv'|] eqn:Hinterp'; simplify_eq/=. | ||
1914 | apply IHHstep in Hinterp' | ||
1915 | as (mw' & m1 & Hinterp1 & Hw); last by eauto using step_not_final. | ||
1916 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
1917 | { exists None, (S m1). by rewrite interp_S /= Hinterp1. } | ||
1918 | destruct (maybe VAttr _) eqn:Hattr; simplify_res; last first. | ||
1919 | { exists None, (S m1). rewrite interp_S /= Hinterp1 /=. | ||
1920 | by assert (maybe VAttr w' = None) as -> by (by destruct v', w'). } | ||
1921 | destruct v', w'; simplify_res. | ||
1922 | rewrite right_id_L in Hinterp. | ||
1923 | eapply interp_proper in Hinterp as (mw & m2 & Hinterp2 & ?); | ||
1924 | last by apply subst_env_fmap_proper. | ||
1925 | exists mw, (S (m1 `max` m2)). rewrite !interp_S /=. | ||
1926 | rewrite (interp_le Hinterp1) /=; last lia. rewrite right_id_L. | ||
1927 | by rewrite (interp_le Hinterp2) /=; last lia. | ||
1928 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1929 | destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
1930 | destruct (interp n _ e') as [mv1|] eqn:Hinterp1; simplify_eq/=. | ||
1931 | apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1); | ||
1932 | last by eauto using step_not_final. | ||
1933 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
1934 | { exists None, (S m). by rewrite interp_S /= Hinterp1. } | ||
1935 | apply (interp_bin_op_proper op) in Hw1. | ||
1936 | destruct (interp_bin_op _ v1) as [f|] eqn:Hopf; simplify_res; last first. | ||
1937 | { exists None, (S m). rewrite interp_S /= Hinterp1 /=. | ||
1938 | by destruct (interp_bin_op _ w1). } | ||
1939 | destruct (interp_bin_op _ w1) as [g|] eqn:Hopg; simplify_res; [|done]. | ||
1940 | destruct (interp n _ e2) as [mv2|] eqn:Hinterp2; simplify_res. | ||
1941 | destruct mv2 as [v2|]; simplify_res; last first. | ||
1942 | { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=. | ||
1943 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1944 | rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hopg. } | ||
1945 | specialize (Hw1 v2 _ eq_refl). | ||
1946 | destruct (f v2) as [t2|], (g v2) as [t2'|] eqn:Hg; simplify_res; last first. | ||
1947 | { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=. | ||
1948 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1949 | rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hopg /= Hg. } | ||
1950 | eapply interp_thunk_proper in Hinterp as (mw & m' & Hthunk & ?); last done. | ||
1951 | exists mw, (S (n `max` m `max` m')). split; [|done]. rewrite interp_S /=. | ||
1952 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1953 | rewrite (interp_le Hinterp2) /=; last lia. rewrite Hopg /= Hg /=. | ||
1954 | rewrite (interp_thunk_le Hthunk) /=; last lia. done. | ||
1955 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1956 | destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
1957 | destruct (interp n ∅ e1) as [mw1|] eqn:Hinterp1; simplify_res. | ||
1958 | apply final_interp in H0 as (v1 & m1 & Hinterp1' & ->). | ||
1959 | apply interp_bin_op_Some_2 in H1 as [f Hop]. | ||
1960 | assert (mw1 = Some v1) as -> by eauto using interp_agree. | ||
1961 | rewrite /= Hop /= in Hinterp. | ||
1962 | destruct (interp _ _ e') as [mv2|] eqn:Hinterp2; simplify_res; last first. | ||
1963 | apply IHHstep in Hinterp2 as (mw2 & m & Hinterp2 & Hw); | ||
1964 | last by eauto using step_not_final. | ||
1965 | destruct mv2 as [v2|], mw2 as [w2|]; simplify_res; last first. | ||
1966 | { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=. | ||
1967 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1968 | rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hop. } | ||
1969 | pose proof @eq_refl as Hf%(interp_bin_op_proper op v1). rewrite !Hop in Hf. | ||
1970 | apply Hf in Hw; clear Hf. | ||
1971 | destruct (f v2) as [t|] eqn:Hf, | ||
1972 | (f w2) as [t'|] eqn:Hf'; simplify_res; last first. | ||
1973 | { exists None, (S (n `max` m)). split; [|done]. rewrite interp_S /=. | ||
1974 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1975 | rewrite (interp_le Hinterp2) /=; last lia. by rewrite Hop /= Hf'. } | ||
1976 | eapply interp_thunk_proper in Hinterp as (mw & m' & Hthunk & ?); last done. | ||
1977 | exists mw, (S (n `max` m `max` m')). split; [|done]. rewrite interp_S /=. | ||
1978 | rewrite (interp_le Hinterp1) /=; last lia. | ||
1979 | rewrite (interp_le Hinterp2) /=; last lia. rewrite Hop /= Hf' /=. | ||
1980 | eauto using interp_thunk_le with lia. | ||
1981 | - split; [|by intros ? []]. intros n mv _ Hinterp. | ||
1982 | destruct n as [|n]; [done|rewrite interp_S /= in Hinterp]. | ||
1983 | destruct (interp n _ e') as [mv1|] eqn:Hinterp1; simplify_eq/=. | ||
1984 | apply IHHstep in Hinterp1 as (mw1 & m & Hinterp1 & Hw1); | ||
1985 | last by eauto using step_not_final. | ||
1986 | destruct mv1 as [v1|], mw1 as [w1|]; simplify_res; last first. | ||
1987 | { exists None, (S m). by rewrite interp_S /= Hinterp1. } | ||
1988 | exists mv, (S (n `max` m)). split; [|done]. | ||
1989 | rewrite interp_S /= (interp_le Hinterp1) /=; last lia. | ||
1990 | assert (maybe_VLit w1 ≫= maybe LitBool = maybe_VLit v1 ≫= maybe LitBool) as ->. | ||
1991 | { destruct v1, w1; repeat destruct select base_lit; naive_solver. } | ||
1992 | destruct (maybe_VLit v1 ≫= maybe LitBool); simplify_res; [|done]. | ||
1993 | eauto using interp_le with lia. | ||
1994 | Qed. | ||
1995 | |||
1996 | Lemma final_interp' μ e : | ||
1997 | final μ e → | ||
1998 | ∃ w m, interp' m μ ∅ e = mret w ∧ e = val_to_expr w. | ||
1999 | Proof. | ||
2000 | intros Hfinal. destruct (final_interp _ _ Hfinal) as (w & m & Hinterp & ->). | ||
2001 | destruct μ. | ||
2002 | { exists w, m. by rewrite interp_shallow'. } | ||
2003 | apply final_force_deep' in Hfinal as (w' & m' & Hforce & ?). | ||
2004 | exists w', (m `max` m'); split; [|done]. rewrite /interp'. | ||
2005 | rewrite (interp_le Hinterp) /=; last lia. eauto using force_deep_le with lia. | ||
2006 | Qed. | ||
2007 | |||
2008 | Lemma force_deep_le' {n1 n2 μ v mv} : | ||
2009 | force_deep' n1 μ v = Res mv → n1 ≤ n2 → force_deep' n2 μ v = Res mv. | ||
2010 | Proof. destruct μ; eauto using force_deep_le. Qed. | ||
2011 | |||
2012 | Lemma interp_le' {n1 n2 μ E e mv} : | ||
2013 | interp' n1 μ E e = Res mv → n1 ≤ n2 → interp' n2 μ E e = Res mv. | ||
2014 | Proof. | ||
2015 | rewrite /interp'. intros. | ||
2016 | destruct (interp n1 _ _) as [mw|] eqn:Hinterp; simplify_res. | ||
2017 | rewrite (interp_le Hinterp); last lia. | ||
2018 | destruct mw; simplify_res; eauto using force_deep_le'. | ||
2019 | Qed. | ||
2020 | |||
2021 | Lemma interp_agree' {n1 n2 μ E e mv1 mv2} : | ||
2022 | interp' n1 μ E e = Res mv1 → interp' n2 μ E e = Res mv2 → mv1 = mv2. | ||
2023 | Proof. | ||
2024 | intros He1 He2. apply (inj Res). destruct (total (≤) n1 n2). | ||
2025 | - rewrite -He2. symmetry. eauto using interp_le'. | ||
2026 | - rewrite -He1. eauto using interp_le'. | ||
2027 | Qed. | ||
2028 | |||
2029 | Lemma interp_step' n μ e1 e2 mv : | ||
2030 | e1 -{μ}-> e2 → | ||
2031 | interp' n μ ∅ e2 = Res mv → | ||
2032 | ∃ mw m, interp' m μ ∅ e1 = Res mw ∧ val_to_expr <$> mv = val_to_expr <$> mw. | ||
2033 | Proof. | ||
2034 | intros Hstep. destruct μ. | ||
2035 | { setoid_rewrite interp_shallow'. | ||
2036 | eapply interp_step; eauto using step_not_final. } | ||
2037 | intros Hinterp. rewrite /interp' in Hinterp. | ||
2038 | destruct (interp n ∅ e2) as [mv'|] eqn:Hinterp'; simplify_res. | ||
2039 | destruct (step_any_shallow _ _ _ Hstep) as [|Hfinal]. | ||
2040 | - eapply interp_step in Hinterp' as (mw' & m & Hinterp' & ?); | ||
2041 | [|by eauto using step_not_final..]. | ||
2042 | destruct mv' as [v'|], mw' as [w'|]; simplify_res; last first. | ||
2043 | { exists None, m. by rewrite /interp' Hinterp'. } | ||
2044 | eapply force_deep_proper in Hinterp as (mw' & m' & Hforce & ?); last done. | ||
2045 | exists mw', (m `max` m'). rewrite /interp'. | ||
2046 | rewrite (interp_le Hinterp') /=; last lia. | ||
2047 | eauto using force_deep_le with lia. | ||
2048 | - assert (final SHALLOW e2) | ||
2049 | as (w2 & m2 & Hinterpw2 & ->)%final_interp by eauto using step_final_shallow. | ||
2050 | apply final_interp in Hfinal as (w1 & m1 & Hinterpw1 & ->). | ||
2051 | apply interp_empty_val_to_expr_Res in Hinterp'; destruct mv'; simplify_res. | ||
2052 | eapply interp_step in Hstep as [_ Hstep]. | ||
2053 | eapply Hstep in Hinterp as (mw & m & Hforce & ?); [|done..]. | ||
2054 | exists mw, (m `max` m1). split; [|done]. rewrite /interp'. | ||
2055 | rewrite (interp_le Hinterpw1) /=; last lia. | ||
2056 | eauto using force_deep_le with lia. | ||
2057 | Qed. | ||
2058 | |||
2059 | Lemma final_val_to_expr' n μ E e v : | ||
2060 | interp' n μ E e = mret v → final μ (val_to_expr v). | ||
2061 | Proof. | ||
2062 | rewrite /interp'. intros Hinterp. | ||
2063 | destruct (interp _ _ e) as [[w|]|] eqn:Hinterp'; simplify_res. | ||
2064 | destruct μ; simplify_res; eauto using final_force_deep. | ||
2065 | Qed. | ||
2066 | |||
2067 | Lemma red_final_interp μ e : | ||
2068 | red (step μ) e ∨ final μ e ∨ ∃ m, interp' m μ ∅ e = mfail. | ||
2069 | Proof. | ||
2070 | revert μ. induction e; intros μ'. | ||
2071 | - (* ELit *) | ||
2072 | destruct (decide (base_lit_ok b)). | ||
2073 | + right; left. by constructor. | ||
2074 | + do 2 right. exists 1. rewrite /interp' interp_S /=. by case_guard. | ||
2075 | - (* EId *) destruct mkd as [[k d]|]. | ||
2076 | + left. eexists; constructor. | ||
2077 | + do 2 right. by exists 1. | ||
2078 | - (* EAbs *) right; left. constructor. | ||
2079 | - (* EAbsMatch *) right; left. constructor. | ||
2080 | - (* EApp *) destruct (IHe1 SHALLOW) as [[??]|[Hfinal|[m Hinterp]]]. | ||
2081 | + left. eexists. by eapply SAppL. | ||
2082 | + apply final_interp in Hfinal as ([] & m & _ & ->); simplify_res. | ||
2083 | { do 2 right. exists 3. rewrite /interp' interp_S /= interp_lit //. } | ||
2084 | { left. by repeat econstructor. } | ||
2085 | { destruct (IHe2 SHALLOW) as [[??]|[Hfinal|[m2 Hinterp2]]]. | ||
2086 | * left. by repeat econstructor. | ||
2087 | * apply final_interp in Hfinal as (w2 & m2 & Hinterp2 & ->). | ||
2088 | destruct (maybe VAttr w2) as [ts|] eqn:Hw2; last first. | ||
2089 | { do 2 right. exists (S (S (S m2))). | ||
2090 | rewrite /interp' !interp_S /= interp_app_S /= interp_thunk_S /=. | ||
2091 | rewrite Hinterp2 /= Hw2. done. } | ||
2092 | destruct w2; simplify_eq/=. | ||
2093 | destruct (interp_match ts (fmap (M:=option) (subst_env E) <$> ms) strict) | ||
2094 | as [E'|] eqn:Hmatch; last first. | ||
2095 | { do 2 right. exists (S (S (S m2))). | ||
2096 | rewrite /interp' !interp_S /= interp_app_S /= interp_thunk_S /=. | ||
2097 | rewrite Hinterp2 /= Hmatch. done. } | ||
2098 | apply interp_match_Some_1 in Hmatch. | ||
2099 | left. repeat econstructor; [done|]. | ||
2100 | by rewrite map_fmap_compose fmap_attr_expr_Attr. | ||
2101 | * rewrite interp_shallow' in Hinterp2. | ||
2102 | do 2 right. exists (S (S (S m2))). | ||
2103 | rewrite /interp' !interp_S /= interp_app_S /= interp_thunk_S /=. | ||
2104 | by rewrite Hinterp2. } | ||
2105 | { do 2 right. by exists 3. } | ||
2106 | destruct (ts !! "__functor") as [e|] eqn:Hfunc. | ||
2107 | { left. repeat econstructor; by simplify_map_eq. } | ||
2108 | do 2 right. exists (S (S m)). rewrite /interp' !interp_S /=. | ||
2109 | rewrite interp_app_S /= !lookup_fmap Hfunc. done. | ||
2110 | + rewrite interp_shallow' in Hinterp. | ||
2111 | do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp. | ||
2112 | - (* ESeq *) destruct (IHe1 μ) as [[??]|[Hfinal|[m Hinterp]]]. | ||
2113 | + left. eexists. by eapply SSeq. | ||
2114 | + left. by repeat econstructor. | ||
2115 | + do 2 right. exists (S m). rewrite /interp' interp_S /=. | ||
2116 | rewrite /interp' in Hinterp. | ||
2117 | destruct (interp _ _ e1) as [[]|], μ; simplify_res; [|done..]. | ||
2118 | by rewrite Hinterp. | ||
2119 | - (* EList *) | ||
2120 | destruct μ'. | ||
2121 | { right; left. by constructor. } | ||
2122 | assert (red (step DEEP) (EList es) ∨ Forall (final DEEP) es ∨ | ||
2123 | ∃ m, mapM (mbind (force_deep m) ∘ interp_thunk m) | ||
2124 | (Thunk ∅ <$> es) = mfail) as Hhelp; last first. | ||
2125 | { destruct Hhelp as [?|[?|[m Hinterp]]]; [by auto using final..|]. | ||
2126 | do 2 right. exists (S m). rewrite /interp' interp_S /=. | ||
2127 | rewrite force_deep_S /=. by rewrite Hinterp. } | ||
2128 | induction H as [|e es He Hes IH]; [by right; left|]. | ||
2129 | destruct (He DEEP) as [[??]|[Hfinal|[m Hinterp]]]; simplify_eq/=. | ||
2130 | + left. eexists. by eapply (SList []). | ||
2131 | + destruct IH as [[??]|[?|[m2 Hinterp2]]]; [|by eauto|]. | ||
2132 | * left. inv_step. eexists. eapply (SList (_ :: _)); by eauto. | ||
2133 | * apply final_interp' in Hfinal as (w & m1 & Hinterp1 & _). | ||
2134 | do 2 right. exists (S (m1 `max` m2)). | ||
2135 | rewrite /interp' /force_deep' in Hinterp1. | ||
2136 | destruct (interp m1 _ _) as [[]|] eqn:Hinterp1'; simplify_res. | ||
2137 | rewrite interp_thunk_S /= (interp_le Hinterp1') /=; last lia. | ||
2138 | rewrite (force_deep_le Hinterp1) /=; last lia. | ||
2139 | rewrite (mapM_interp_le Hinterp2) /=; last lia. done. | ||
2140 | + do 2 right. exists (S m). | ||
2141 | rewrite /interp' /force_deep' in Hinterp. | ||
2142 | destruct (interp m _ _) as [mw|] eqn:Hinterp1'; simplify_res. | ||
2143 | rewrite interp_thunk_S /= Hinterp1' /=. | ||
2144 | destruct mw as [w|]; simplify_res; [|done]. | ||
2145 | rewrite (force_deep_le Hinterp) /=; last lia. done. | ||
2146 | - (* EAttr *) destruct (decide (no_recs αs)) as [Hrecs|]; last first. | ||
2147 | { left. by repeat econstructor. } | ||
2148 | destruct μ'. | ||
2149 | { right; left. by constructor. } | ||
2150 | assert (red (step DEEP) (EAttr αs) ∨ | ||
2151 | map_Forall (λ _, final DEEP ∘ attr_expr) αs ∨ | ||
2152 | ∃ m, map_mapM_sorted attr_le (mbind (force_deep m) ∘ interp_thunk m) | ||
2153 | (Thunk ∅ ∘ attr_expr <$> αs) = mfail) as Hhelp; last first. | ||
2154 | { destruct Hhelp as [?|[?|[m Hinterp]]]; [by auto using final..|]. | ||
2155 | do 2 right. exists (S m). rewrite /interp' interp_S /=. | ||
2156 | rewrite from_attr_no_recs //. rewrite force_deep_S /=. by rewrite Hinterp. } | ||
2157 | induction αs as [|x [τ e] es Hx ? IH] | ||
2158 | using (map_sorted_ind attr_le); [by right; left|]. | ||
2159 | rewrite !map_Forall_insert //. | ||
2160 | apply map_Forall_insert in H as [He Hes%IH]; clear IH; | ||
2161 | [|by eauto using no_recs_insert_inv..]. | ||
2162 | assert (τ = NONREC) as -> by (by eapply no_recs_lookup, lookup_insert). | ||
2163 | assert (∀ y, is_Some ((Thunk ∅ ∘ attr_expr <$> es) !! y) → attr_le x y). | ||
2164 | { intros y. rewrite lookup_fmap fmap_is_Some. eauto. } | ||
2165 | destruct (He DEEP) as [[??]|[Hfinal|[m Hinterp]]]; simplify_eq/=. | ||
2166 | + left. eexists; eapply SAttr; naive_solver eauto using no_recs_insert_inv. | ||
2167 | + destruct Hes as [[??]|[?|[m2 Hinterp2]]]; [|by eauto|]. | ||
2168 | * left. inv_step; first by naive_solver eauto using no_recs_insert_inv. | ||
2169 | apply lookup_insert_None in Hx as [??]. | ||
2170 | rewrite insert_commute // in Hrecs. rewrite insert_commute //. | ||
2171 | eexists; eapply SAttr; [|by rewrite lookup_insert_ne| |done]. | ||
2172 | { eapply no_recs_insert_inv; [|done]. by rewrite lookup_insert_ne. } | ||
2173 | intros ?? [[<- <-]|[??]]%lookup_insert_Some; eauto. | ||
2174 | * apply final_interp' in Hfinal as (w & m1 & Hinterp1 & _). | ||
2175 | do 2 right. exists (S (m1 `max` m2)). rewrite fmap_insert /=. | ||
2176 | rewrite map_mapM_sorted_insert //=; last by rewrite lookup_fmap Hx. | ||
2177 | rewrite /interp' /force_deep' in Hinterp1. | ||
2178 | destruct (interp m1 _ _) as [[]|] eqn:Hinterp1'; simplify_res. | ||
2179 | rewrite interp_thunk_S /= (interp_le Hinterp1') /=; last lia. | ||
2180 | rewrite (force_deep_le Hinterp1) /=; last lia. | ||
2181 | rewrite (map_mapM_interp_le Hinterp2) /=; last lia. done. | ||
2182 | + do 2 right. exists (S m). rewrite fmap_insert /=. | ||
2183 | rewrite map_mapM_sorted_insert //=; last by rewrite lookup_fmap Hx. | ||
2184 | rewrite /interp' /force_deep' in Hinterp. | ||
2185 | destruct (interp m _ _) as [mw|] eqn:Hinterp'; simplify_res. | ||
2186 | rewrite interp_thunk_S /= (interp_le Hinterp') /=; last lia. | ||
2187 | destruct mw as [w|]; simplify_res; [|done]. | ||
2188 | rewrite (force_deep_le Hinterp) /=; last lia. done. | ||
2189 | - (* ELetAttr *) destruct (IHe1 SHALLOW) as [[??]|[Hfinal|[m Hinterp]]]. | ||
2190 | + left. eexists. by eapply SLetAttr. | ||
2191 | + apply final_interp in Hfinal as (w & m & Hinterp & ->). | ||
2192 | destruct (maybe VAttr w) eqn:Hw. | ||
2193 | { destruct w; simplify_eq/=. left. by repeat econstructor. } | ||
2194 | do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp /= Hw. | ||
2195 | + do 2 right. exists (S m). rewrite interp_shallow' in Hinterp. | ||
2196 | by rewrite /interp' interp_S /= Hinterp /=. | ||
2197 | - (* EBinOp *) | ||
2198 | destruct (IHe1 SHALLOW) as [[??]|[Hfinal1|[m Hinterp]]]. | ||
2199 | + left. eexists. by eapply SBinOpL. | ||
2200 | + apply final_interp in Hfinal1 as (w1 & m1 & Hinterp1 & ->). | ||
2201 | destruct (interp_bin_op op w1) as [f|] eqn:Hop; last first. | ||
2202 | { do 2 right. exists (S m1). rewrite /interp' interp_S /=. | ||
2203 | by rewrite Hinterp1 /= Hop. } | ||
2204 | pose proof Hop as [Φ ?]%interp_bin_op_Some_1. | ||
2205 | destruct (IHe2 SHALLOW) as [[??]|[Hfinal2|[m Hinterp2]]]. | ||
2206 | * left. by repeat econstructor. | ||
2207 | * apply final_interp in Hfinal2 as (w2 & m2 & Hinterp2 & ->). | ||
2208 | destruct (f w2) as [w|] eqn:Hf; last first. | ||
2209 | ** do 2 right. exists (S (m1 `max` m2)). rewrite /interp' interp_S /=. | ||
2210 | rewrite (interp_le Hinterp1) /=; last lia. | ||
2211 | rewrite Hop /= (interp_le Hinterp2) /=; last lia. by rewrite Hf. | ||
2212 | ** eapply interp_bin_op_Some_Some_1 in Hf as (?&?&?); [|done..]. | ||
2213 | left. by repeat econstructor. | ||
2214 | * rewrite interp_shallow' in Hinterp2. | ||
2215 | do 2 right. exists (S (m `max` m1)). rewrite /interp' interp_S /=. | ||
2216 | rewrite (interp_le Hinterp1) /=; last lia. | ||
2217 | rewrite Hop /= (interp_le Hinterp2) /=; last lia. done. | ||
2218 | + rewrite interp_shallow' in Hinterp. | ||
2219 | do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp. | ||
2220 | - (* EIf *) | ||
2221 | destruct (IHe1 SHALLOW) as [[??]|[Hfinal1|[m Hinterp]]]. | ||
2222 | + left. eexists. by eapply SIf. | ||
2223 | + apply final_interp in Hfinal1 as (w1 & m1 & Hinterp1 & ->). | ||
2224 | destruct (maybe_VLit w1 ≫= maybe LitBool) as [b|] eqn:Hbool; last first. | ||
2225 | { do 2 right. exists (S m1). | ||
2226 | rewrite /interp' interp_S /= Hinterp1 /= Hbool. done. } | ||
2227 | left. destruct w1; repeat destruct select base_lit; simplify_eq/=. | ||
2228 | eexists; constructor. | ||
2229 | + rewrite interp_shallow' in Hinterp. | ||
2230 | do 2 right. exists (S m). by rewrite /interp' interp_S /= Hinterp. | ||
2231 | Qed. | ||
2232 | |||
2233 | Lemma interp_complete μ e1 e2 : | ||
2234 | e1 -{μ}->* e2 → nf (step μ) e2 → | ||
2235 | ∃ mw m, interp' m μ ∅ e1 = Res mw ∧ | ||
2236 | if mw is Some w then e2 = val_to_expr w else ¬final μ e2. | ||
2237 | Proof. | ||
2238 | intros Hsteps Hnf. induction Hsteps as [e|e1 e2 e3 Hstep _ IH]. | ||
2239 | { destruct (red_final_interp μ e) as [?|[Hfinal|[m Hinterp]]]; [done|..]. | ||
2240 | - apply final_interp' in Hfinal as (w & m & ? & ?). | ||
2241 | by exists (Some w), m. | ||
2242 | - exists None, m. split; [done|]. intros Hfinal. | ||
2243 | apply final_interp' in Hfinal as (w & m' & Hinterp' & _). | ||
2244 | rewrite /interp' in Hinterp, Hinterp'. | ||
2245 | by assert (mfail = mret w) by eauto using interp_agree'. } | ||
2246 | destruct IH as (mw & m & Hinterp & ?); first done. | ||
2247 | eapply interp_step' in Hstep as (mw' & m' & ? & ?); last done. | ||
2248 | destruct mw, mw'; naive_solver. | ||
2249 | Qed. | ||
2250 | |||
2251 | Lemma interp_complete_ret μ e1 e2 : | ||
2252 | e1 -{μ}->* e2 → final μ e2 → | ||
2253 | ∃ w m, interp' m μ ∅ e1 = mret w ∧ e2 = val_to_expr w. | ||
2254 | Proof. | ||
2255 | intros Hsteps Hfinal. apply interp_complete in Hsteps | ||
2256 | as ([w|] & m & ? & ?); naive_solver eauto using final_nf. | ||
2257 | Qed. | ||
2258 | Lemma interp_complete_fail μ e1 e2 : | ||
2259 | e1 -{μ}->* e2 → nf (step μ) e2 → ¬final μ e2 → | ||
2260 | ∃ m, interp' m μ ∅ e1 = mfail. | ||
2261 | Proof. | ||
2262 | intros Hsteps Hnf Hfinal. | ||
2263 | apply interp_complete in Hsteps as ([w|] & m & ? & ?); | ||
2264 | naive_solver eauto using final_val_to_expr'. | ||
2265 | Qed. | ||
2266 | |||
2267 | Lemma interp_sound_open n E e mv : | ||
2268 | interp n E e = Res mv → | ||
2269 | ∃ e', subst_env E e -{SHALLOW}->* e' ∧ | ||
2270 | if mv is Some v' then e' = val_to_expr v' else stuck SHALLOW e' | ||
2271 | with interp_thunk_sound n t mv : | ||
2272 | interp_thunk n t = Res mv → | ||
2273 | ∃ e', thunk_to_expr t -{SHALLOW}->* e' ∧ | ||
2274 | if mv is Some v' then e' = val_to_expr v' else stuck SHALLOW e' | ||
2275 | with interp_app_sound n v1 t2 mv : | ||
2276 | interp_app n v1 t2 = Res mv → | ||
2277 | ∃ e', EApp (val_to_expr v1) (thunk_to_expr t2) -{SHALLOW}->* e' ∧ | ||
2278 | if mv is Some v' then e' = val_to_expr v' else stuck SHALLOW e' | ||
2279 | with force_deep_sound n v mv : | ||
2280 | force_deep n v = Res mv → | ||
2281 | ∃ e', val_to_expr v -{DEEP}->* e' ∧ | ||
2282 | if mv is Some v' then e' = val_to_expr v' else stuck DEEP e'. | ||
2283 | Proof. | ||
2284 | - destruct n as [|n]; [done|]. | ||
2285 | rewrite subst_env_eq interp_S. intros Hinterp. | ||
2286 | destruct e; simplify_res. | ||
2287 | + (* ELit *) case_guard; simplify_res. | ||
2288 | * by eexists. | ||
2289 | * eexists; split; [done|]. split; [|by inv 1]. intros [??]; inv_step. | ||
2290 | + (* EId *) | ||
2291 | assert (union_kinded (prod_map id thunk_to_expr <$> E !! x) mke | ||
2292 | = prod_map id thunk_to_expr <$> (union_kinded (E !! x) | ||
2293 | (prod_map id (Thunk ∅) <$> mke))) as ->. | ||
2294 | { destruct (_ !! _) as [[[]]|], mke as [[[]]|]; | ||
2295 | by rewrite /= ?thunk_to_expr_eq /= ?subst_env_empty. } | ||
2296 | destruct (union_kinded _ _) as [[k t]|]; simplify_res. | ||
2297 | * apply interp_thunk_sound in Hinterp as (e' & Hsteps & He'). | ||
2298 | exists e'; split; [|done]. eapply rtc_l; [constructor|done]. | ||
2299 | * eexists; split; [done|]. split; [|inv 1]. intros [? Hstep]. inv_step. | ||
2300 | + (* EAbs *) by eexists. | ||
2301 | + (* EAbsMatch *) by eexists. | ||
2302 | + (* EApp *) | ||
2303 | destruct (interp _ _ _) as [mv1|] eqn:Hinterp1; simplify_res. | ||
2304 | apply interp_sound_open in Hinterp1 as (e1' & Hsteps1 & He1'). | ||
2305 | destruct mv1 as [v1|]; simplify_res; last first. | ||
2306 | { eexists; split; [by eapply SAppL_rtc|]. split; [|inv 1]. | ||
2307 | intros [??]. destruct He1' as [Hnf []]. | ||
2308 | inv_step; eauto using final. destruct Hnf; eauto. } | ||
2309 | apply interp_app_sound in Hinterp as (e' & Hsteps2 & He'). | ||
2310 | eexists e'; split; [|done]. etrans; [|done]. by eapply SAppL_rtc. | ||
2311 | + (* ESeq *) destruct (interp _ _ e1) as [mv'|] eqn:Hinterp'; simplify_res. | ||
2312 | apply interp_sound_open in Hinterp' as (e' & Hsteps & He'). | ||
2313 | destruct mv' as [v'|]; simplify_res; last first. | ||
2314 | { eexists; repeat split; [by apply SSeq_rtc, steps_shallow_any| |inv 1]. | ||
2315 | intros [e'' Hstep]. destruct He' as [Hnf Hfinal]. | ||
2316 | destruct Hfinal. inv_step; eauto using final_any_shallow. | ||
2317 | apply step_any_shallow in H2 as []; [|done]. destruct Hnf; eauto. } | ||
2318 | destruct μ; simplify_res. | ||
2319 | { apply interp_sound_open in Hinterp as (e'' & Hsteps' & He''). | ||
2320 | eexists; split; [|done]. etrans; first by apply SSeq_rtc. | ||
2321 | eapply rtc_l; first by apply SSeqFinal. done. } | ||
2322 | destruct (force_deep _ _) as [mw|] eqn:Hforce; simplify_res. | ||
2323 | pose proof Hforce as Hforce'. | ||
2324 | apply force_deep_sound in Hforce' as (e'' & Hsteps' & He''). | ||
2325 | destruct mw as [w|]; simplify_res; last first. | ||
2326 | { eexists. split. | ||
2327 | { etrans; [by eapply SSeq_rtc, steps_shallow_any|]. | ||
2328 | etrans; [by eapply SSeq_rtc|]. done. } | ||
2329 | split; [|inv 1]. destruct He''. intros [e''' Hstep]. | ||
2330 | inv_step; eauto using step_not_final. } | ||
2331 | apply interp_sound_open in Hinterp as (e''' & Hsteps'' & He'''). | ||
2332 | exists e'''. split; [|done]. | ||
2333 | etrans; [by eapply SSeq_rtc, steps_shallow_any|]. | ||
2334 | etrans; [by eapply SSeq_rtc|]. | ||
2335 | eapply rtc_l; first by eapply SSeqFinal, final_force_deep. done. | ||
2336 | + (* EList *) | ||
2337 | eexists; split; [done|]. f_equal. | ||
2338 | induction es; f_equal/=; auto. | ||
2339 | + (* EAttr *) | ||
2340 | eexists; split; [apply SAttr_rec_rtc|]. | ||
2341 | f_equal. apply map_eq=> x. rewrite !lookup_fmap. | ||
2342 | destruct (αs !! x) as [[[] e]|] eqn:?; do 2 f_equal/=. | ||
2343 | by rewrite subst_env_indirects_env_attr_to_tattr. | ||
2344 | + (* ELetAttr *) destruct (interp _ _ _) as [mv'|] eqn:Hinterp'; simplify_res. | ||
2345 | apply interp_sound_open in Hinterp' as (e' & Hsteps & He'). | ||
2346 | destruct mv' as [v'|]; simplify_res; last first. | ||
2347 | { eexists; repeat split; [by apply SLetAttr_rtc| |inv 1]. | ||
2348 | intros [e'' Hstep]. destruct He' as [Hnf Hfinal]. | ||
2349 | inv_step; [by destruct Hfinal; constructor|]. destruct Hnf; eauto. } | ||
2350 | destruct (maybe VAttr v') eqn:?; simplify_res; last first. | ||
2351 | { eexists; repeat split; [by apply SLetAttr_rtc| |inv 1]. | ||
2352 | intros [e'' Hstep]. destruct v'; inv_step; simplify_eq/=. } | ||
2353 | destruct v'; simplify_res. | ||
2354 | apply interp_sound_open in Hinterp as (e'' & Hsteps' & He''). | ||
2355 | eexists; split; [|done]. etrans; [by apply SLetAttr_rtc|]. | ||
2356 | eapply rtc_l; [by econstructor|]. | ||
2357 | rewrite subst_env_union in Hsteps'. | ||
2358 | rewrite subst_env_alt -!map_fmap_compose in Hsteps'. | ||
2359 | by rewrite -map_fmap_compose. | ||
2360 | + (* EBinOp *) | ||
2361 | destruct (interp _ _ e1) as [mv1|] eqn:Hinterp1; simplify_res. | ||
2362 | apply interp_sound_open in Hinterp1 as (e1' & Hsteps1 & He1'). | ||
2363 | destruct mv1 as [v1|]; simplify_res; last first. | ||
2364 | { eexists; split; [by eapply SBinOpL_rtc|]. split; [|inv 1]. | ||
2365 | intros [? Hstep]. destruct He1'. inv_step; naive_solver. } | ||
2366 | destruct (interp_bin_op _ v1) as [f|] eqn:Hop; simplify_res; last first. | ||
2367 | { assert (¬∃ Φ, sem_bin_op op (val_to_expr v1) Φ). | ||
2368 | { by intros [? ?%interp_bin_op_Some_2%not_eq_None_Some]. } | ||
2369 | eexists; split; [by eapply SBinOpL_rtc|]. split; [|inv 1]. | ||
2370 | intros [? Hstep]. inv_step; eauto using step_not_val_to_expr. } | ||
2371 | pose proof Hop as [Φ ?]%interp_bin_op_Some_1. | ||
2372 | destruct (interp _ _ e2) as [mv2|] eqn:Hinterp2; simplify_res. | ||
2373 | apply interp_sound_open in Hinterp2 as (e2' & Hsteps2 & He2'). | ||
2374 | destruct mv2 as [v2|]; simplify_res; last first. | ||
2375 | { eexists; split. | ||
2376 | { etrans; [by eapply SBinOpL_rtc|]. | ||
2377 | eapply SBinOpR_rtc; eauto using interp_bin_op_Some_1. } | ||
2378 | split; [|inv 1]. destruct He2'. | ||
2379 | intros [? Hstep]. inv_step; eauto using step_not_val_to_expr. } | ||
2380 | destruct (f v2) eqn:Hf; simplify_res; last first. | ||
2381 | { eexists; split. | ||
2382 | { etrans; [by eapply SBinOpL_rtc|]. | ||
2383 | eapply SBinOpR_rtc; eauto using interp_bin_op_Some_1. } | ||
2384 | split; [|inv 1]. pose proof @interp_bin_op_Some_Some_2. | ||
2385 | intros [? Hstep]. inv_step; naive_solver eauto using step_not_val_to_expr. } | ||
2386 | apply interp_thunk_sound in Hinterp as (e' & Hsteps3 & He'). | ||
2387 | eapply interp_bin_op_Some_Some_1 in Hf as (e3 & ? & ?); [|done..]. | ||
2388 | eapply delayed_steps_l in Hsteps3 | ||
2389 | as (e'' & Hsteps3 & Hdel); last done. | ||
2390 | eexists e''; split. | ||
2391 | { etrans; [by eapply SBinOpL_rtc|]. | ||
2392 | etrans; [eapply SBinOpR_rtc; eauto using interp_bin_op_Some_1|]. | ||
2393 | eapply rtc_l; [by econstructor|]. done. } | ||
2394 | destruct mv. | ||
2395 | { subst e'. eapply delayed_final_l in Hdel as <-; done. } | ||
2396 | destruct He' as [Hnf Hfinal]. split. | ||
2397 | { intros [e4 Hsteps4]. destruct Hnf. | ||
2398 | eapply delayed_step_r in Hsteps4 as (e4' & Hstep4' & ?); [|done]. | ||
2399 | destruct Hstep4'; eauto. } | ||
2400 | intros Hfinal'. eapply Hnf. | ||
2401 | eapply delayed_final_r in Hfinal' as Hsteps; [|done]. | ||
2402 | destruct Hsteps; by eauto. | ||
2403 | + (* EIf *) | ||
2404 | destruct (interp _ _ e1) as [mv1|] eqn:Hinterp1; simplify_res. | ||
2405 | apply interp_sound_open in Hinterp1 as (e1' & Hsteps1 & He1'). | ||
2406 | destruct mv1 as [v1|]; simplify_res; last first. | ||
2407 | { eexists; repeat split; [by apply SIf_rtc| |inv 1]. | ||
2408 | intros [e'' Hstep]. destruct He1' as [Hnf Hfinal]. | ||
2409 | destruct Hfinal. inv_step; eauto using final. destruct Hnf; eauto. } | ||
2410 | destruct (maybe_VLit v1 ≫= maybe LitBool) as [b|] eqn:Hbool; | ||
2411 | simplify_res; last first. | ||
2412 | { eexists; repeat split; [by apply SIf_rtc| |inv 1]. | ||
2413 | intros [e'' ?]. destruct v1; inv_step; eauto using final. } | ||
2414 | apply interp_sound_open in Hinterp as (e' & Hsteps & He'). | ||
2415 | exists e'; split; [|done]. etrans; [by apply SIf_rtc|]. | ||
2416 | assert (val_to_expr v1 = ELit (LitBool b)) as ->. | ||
2417 | { destruct v1; repeat destruct select base_lit; naive_solver. } | ||
2418 | eapply rtc_l; [constructor|]. by destruct b. | ||
2419 | - destruct n as [|n]; [done|]. rewrite interp_thunk_S /=. | ||
2420 | intros Hthunk. destruct t; simplify_res; [by eauto using rtc..|]. | ||
2421 | destruct (tαs !! x) as [[e|t]|] eqn:Hx; simplify_res. | ||
2422 | + apply interp_sound_open in Hthunk as (e' & Hsteps & ?). | ||
2423 | exists e'; split; [|done]. etrans; [eapply SBinOpL_rtc, SAttr_rec_rtc|]. | ||
2424 | eapply rtc_l; [eapply SBinOp; repeat constructor|]; try done; simpl. | ||
2425 | eexists; split; [done|]. rewrite !lookup_fmap Hx /=. | ||
2426 | rewrite -subst_env_indirects_env_attr_to_tattr_empty. | ||
2427 | by rewrite -subst_env_indirects_env. | ||
2428 | + apply interp_thunk_sound in Hthunk as (e' & Hsteps & ?). | ||
2429 | exists e'; split; [|done]. etrans; [eapply SBinOpL_rtc, SAttr_rec_rtc|]. | ||
2430 | eapply rtc_l; [eapply SBinOp; repeat constructor|]; try done; simpl. | ||
2431 | eexists; split; [done|]. by rewrite !lookup_fmap Hx /=. | ||
2432 | + eexists. split; [eapply SBinOpL_rtc, SAttr_rec_rtc|]. split; [|inv 1]. | ||
2433 | intros [??]. inv_step. inv H7. destruct H8 as (? & ? & Hx'); simplify_eq/=. | ||
2434 | by rewrite !lookup_fmap Hx in Hx'. | ||
2435 | - destruct n as [|n]; [done|]. rewrite interp_app_S /=. intros Happ. | ||
2436 | destruct v1; simplify_res. | ||
2437 | + eexists; split; [done|]. split; [|inv 1]. intros [??]; inv_step. | ||
2438 | + eapply interp_sound_open in Happ as (e' & Hsteps & He'). | ||
2439 | eexists; split; [|done]. eapply rtc_l; [constructor|]. | ||
2440 | rewrite subst_abs_env_insert // in Hsteps. | ||
2441 | + destruct (interp_thunk _ _) as [mv'|] eqn:Hthunk; simplify_res. | ||
2442 | apply interp_thunk_sound in Hthunk as (et & Htsteps & Het). | ||
2443 | destruct mv' as [v'|]; simplify_res; last first. | ||
2444 | { eexists; split; [by eapply SAppR_rtc|]. | ||
2445 | split; [|inv 1]. destruct Het. | ||
2446 | intros [??]; inv_step; eauto using final. } | ||
2447 | destruct (maybe VAttr v') as [ts|] eqn:?; simplify_res; last first. | ||
2448 | { eexists; repeat split; [by apply SAppR_rtc| |inv 1]. | ||
2449 | intros [e'' Hstep]. destruct v'; inv_step; simplify_eq/=. } | ||
2450 | destruct v'; simplify_res. | ||
2451 | destruct (interp_match _ _ _) as [tαs|] eqn:Hmatch; | ||
2452 | simplify_res; last first. | ||
2453 | { eexists; repeat split; [by apply SAppR_rtc| |inv 1]. | ||
2454 | intros [e'' Hstep]. inv_step. | ||
2455 | rewrite map_fmap_compose fmap_attr_expr_Attr in H6. | ||
2456 | apply interp_match_Some_2 in H6. rewrite interp_match_subst in H6. | ||
2457 | opose proof (interp_match_proper ∅ ∅ | ||
2458 | (Thunk ∅ <$> (thunk_to_expr <$> ts)) ts ms ms strict _ _). | ||
2459 | { apply map_eq=> x. rewrite !lookup_fmap. | ||
2460 | destruct (ts !! x); f_equal/=. by rewrite subst_env_empty. } | ||
2461 | { done. } | ||
2462 | repeat destruct (interp_match _ _ _); simplify_eq/=. } | ||
2463 | pose proof (interp_match_subst E ts ms strict) as Hmatch'. | ||
2464 | rewrite Hmatch /= in Hmatch'. | ||
2465 | apply interp_match_Some_1 in Hmatch'. | ||
2466 | apply interp_sound_open in Happ as (e' & Hsteps & ?). | ||
2467 | exists e'; split; [|done]. | ||
2468 | etrans; [by apply SAppR_rtc|]. | ||
2469 | eapply rtc_l; [constructor; [done|]|]. | ||
2470 | { rewrite map_fmap_compose fmap_attr_expr_Attr. done. } | ||
2471 | etrans; [|apply Hsteps]. apply reflexive_eq. f_equal. | ||
2472 | rewrite subst_env_indirects_env. | ||
2473 | rewrite subst_env_indirects_env_attr_to_tattr_empty. | ||
2474 | do 2 f_equal. apply map_eq=> y. rewrite !lookup_fmap. | ||
2475 | destruct (_ !! y) as [[]|]; f_equal/=. by rewrite subst_env_empty. | ||
2476 | + eexists; split; [done|]. split; [|inv 1]. intros [??]; inv_step. | ||
2477 | + destruct (ts !! _) eqn:Hfunc; simplify_res; last first. | ||
2478 | { eexists; split; [by eapply SAppL_rtc|]. split; [|inv 1]. | ||
2479 | intros [??]; inv_step; simplify_map_eq. } | ||
2480 | destruct (interp_thunk _ _) as [mv'|] eqn:Hthunk; simplify_res. | ||
2481 | apply interp_thunk_sound in Hthunk as (et & Htsteps & Het). | ||
2482 | assert (EApp (EAttr (AttrN ∘ thunk_to_expr <$> ts)) (thunk_to_expr t2) | ||
2483 | -{SHALLOW}->* | ||
2484 | EApp (EApp et (EAttr (AttrN ∘ thunk_to_expr <$> ts))) (thunk_to_expr t2)) | ||
2485 | as Hsteps; [|clear Htsteps]. | ||
2486 | { eapply rtc_l; [constructor; by simplify_map_eq|]. | ||
2487 | eapply SAppL_rtc, SAppL_rtc, Htsteps. } | ||
2488 | destruct mv' as [v'|]; simplify_res; last first. | ||
2489 | { eexists; split; [exact Hsteps|]. | ||
2490 | split; [|inv 1]. intros [??]. destruct Het as [Hnf []]. | ||
2491 | inv_step; eauto using final. destruct Hnf; eauto. } | ||
2492 | destruct (interp_app _ _ _) as [mv'|] eqn:Happ'; simplify_res. | ||
2493 | apply interp_app_sound in Happ' as (e' & Hsteps' & He'). | ||
2494 | destruct mv' as [v''|]; simplify_res; last first. | ||
2495 | { eexists; split; [etrans; [apply Hsteps|apply SAppL_rtc, Hsteps']|]. | ||
2496 | split; [|inv 1]. intros [??]. destruct He' as [Hnf []]. | ||
2497 | inv_step; eauto using final. destruct Hnf; eauto. } | ||
2498 | apply interp_app_sound in Happ as (e'' & Hsteps'' & He''). | ||
2499 | eexists e''; split; [|done]. | ||
2500 | etrans; [apply Hsteps|]. etrans; [apply SAppL_rtc, Hsteps'|]. done. | ||
2501 | - destruct n as [|n]; [done|]. rewrite force_deep_S. | ||
2502 | intros Hforce. destruct v; simplify_res. | ||
2503 | + (* VLit *) by eexists. | ||
2504 | + (* VAbs *) by eexists. | ||
2505 | + (* VAbsMatch *) by eexists. | ||
2506 | + (* VList *) | ||
2507 | destruct (mapM _ _) as [mvs|] eqn:Hmap; simplify_res. | ||
2508 | assert (∃ ts', | ||
2509 | EList (thunk_to_expr <$> ts) -{DEEP}->* EList (thunk_to_expr <$> ts') ∧ | ||
2510 | if mvs is Some vs then thunk_to_expr <$> ts' = val_to_expr <$> vs | ||
2511 | else nf (step DEEP) (EList (thunk_to_expr <$> ts')) ∧ | ||
2512 | ¬Forall (final DEEP ∘ thunk_to_expr) ts') | ||
2513 | as (ts' & Hsteps & Hts'); last first. | ||
2514 | { eexists; split; [done|]. destruct mvs as [vs|]; simplify_eq/=. | ||
2515 | * f_equal. rewrite -list_fmap_compose Hts'. | ||
2516 | clear. induction vs; f_equal/=; auto. | ||
2517 | * destruct Hts' as [Hnf Hfinal]; split; [done|]. | ||
2518 | inv 1. by apply Hfinal, Forall_fmap. } | ||
2519 | revert mvs Hmap. induction ts as [|t ts IH]; intros mv' Hmap; simplify_res. | ||
2520 | { by exists []. } | ||
2521 | destruct (interp_thunk _ _) as [mv''|] eqn:Hthunk; simplify_res. | ||
2522 | apply interp_thunk_sound in Hthunk as (et & Htsteps & Het). | ||
2523 | destruct mv'' as [v''|]; simplify_res; last first. | ||
2524 | { exists (Thunk ∅ et :: ts); csimpl. rewrite subst_env_empty. | ||
2525 | apply (stuck_shallow_any DEEP) in Het as [??]. split_and!. | ||
2526 | * eapply (SList_rtc []); [done|]. | ||
2527 | etrans; [by apply steps_shallow_any|done]. | ||
2528 | * by apply List_nf_cons. | ||
2529 | * rewrite Forall_cons /= subst_env_empty. | ||
2530 | naive_solver eauto using final_any_shallow. } | ||
2531 | destruct (force_deep _ _) as [mvf|] eqn:Hforce; simplify_res. | ||
2532 | pose proof Hforce as Hforce'. | ||
2533 | apply force_deep_sound in Hforce' as (e' & Hsteps' & He'). | ||
2534 | destruct mvf as [vf|]; simplify_res; last first. | ||
2535 | { exists (Thunk ∅ e' :: ts). csimpl. rewrite subst_env_empty. | ||
2536 | destruct He'. split_and!. | ||
2537 | * eapply (SList_rtc []); [done|]. | ||
2538 | etrans; [by apply steps_shallow_any|done]. | ||
2539 | * by apply List_nf_cons. | ||
2540 | * rewrite Forall_cons /= subst_env_empty. naive_solver. } | ||
2541 | destruct (mapM _ _) as [mvs|] eqn:Hmap'; simplify_res. | ||
2542 | destruct (IH _ eq_refl) as (ts' & Hsteps'' & Hts'). | ||
2543 | exists (Forced vf :: ts'); csimpl. split. | ||
2544 | { etrans; [eapply (SList_rtc []); [done..|]; | ||
2545 | etrans; [by apply steps_shallow_any|done]|]; simpl. | ||
2546 | eapply List_steps_cons; by eauto using final_force_deep. } | ||
2547 | destruct mvs as [vs|]; simplify_res. | ||
2548 | { by rewrite Hts'. } | ||
2549 | split; [|rewrite Forall_cons; naive_solver]. | ||
2550 | apply List_nf_cons_final; naive_solver eauto using final_force_deep. | ||
2551 | + (* VAttr *) | ||
2552 | destruct (map_mapM_sorted _ _) as [mvs|] eqn:Hmap; simplify_res. | ||
2553 | assert (∃ ts', | ||
2554 | EAttr (AttrN ∘ thunk_to_expr <$> ts) -{DEEP}->* | ||
2555 | EAttr (AttrN ∘ thunk_to_expr <$> ts') ∧ | ||
2556 | if mvs is Some vs then thunk_to_expr <$> ts' = val_to_expr <$> vs | ||
2557 | else nf (step DEEP) (EAttr (AttrN ∘ thunk_to_expr <$> ts')) ∧ | ||
2558 | ¬map_Forall (λ _, final DEEP ∘ thunk_to_expr) ts') | ||
2559 | as (ts' & Hsteps & Hts'); last first. | ||
2560 | { eexists; split; [done|]. destruct mvs as [vs|]; simplify_eq/=. | ||
2561 | * f_equal. rewrite map_fmap_compose Hts'. | ||
2562 | apply map_eq=> x. rewrite !lookup_fmap. by destruct (vs !! x). | ||
2563 | * destruct Hts' as [Hnf Hfinal]; split; [done|]. | ||
2564 | inv 1. apply Hfinal=> x t Hx /=. | ||
2565 | ospecialize (H2 x _ _); first by rewrite lookup_fmap Hx. done. } | ||
2566 | revert mvs Hmap. induction ts as [|x t ts Hx ? IH] | ||
2567 | using (map_sorted_ind attr_le); intros mv' Hmap. | ||
2568 | { rewrite map_mapM_sorted_empty in Hmap; simplify_res. by exists ∅. } | ||
2569 | rewrite map_mapM_sorted_insert //= in Hmap. | ||
2570 | assert ((AttrN ∘ thunk_to_expr <$> ts) !! x = None). | ||
2571 | { by rewrite lookup_fmap Hx. } | ||
2572 | assert (∀ y α, (AttrN ∘ thunk_to_expr <$> ts) !! y = Some α → | ||
2573 | final DEEP (attr_expr α) ∨ attr_le x y). | ||
2574 | { intros y α. rewrite lookup_fmap. destruct (ts !! y) eqn:?; naive_solver. } | ||
2575 | destruct (interp_thunk _ _) as [mv''|] eqn:Hthunk; simplify_res. | ||
2576 | apply interp_thunk_sound in Hthunk as (et & Htsteps & Het). | ||
2577 | destruct mv'' as [v''|]; simplify_res; last first. | ||
2578 | { exists (<[x:=Thunk ∅ et]> ts). | ||
2579 | rewrite !fmap_insert /= subst_env_empty. | ||
2580 | apply (stuck_shallow_any DEEP) in Het as [??]. split_and!. | ||
2581 | * eapply SAttr_lookup_rtc; [done..|]. | ||
2582 | etrans; [by apply steps_shallow_any|done]. | ||
2583 | * apply Attr_nf_insert; auto. | ||
2584 | intros y. rewrite lookup_fmap fmap_is_Some. eauto. | ||
2585 | * rewrite map_Forall_insert //= subst_env_empty. | ||
2586 | naive_solver eauto using final_any_shallow. } | ||
2587 | destruct (force_deep _ _) as [mvf|] eqn:Hforce; simplify_res. | ||
2588 | pose proof Hforce as Hforce'. | ||
2589 | apply force_deep_sound in Hforce' as (e' & Hsteps' & He'). | ||
2590 | destruct mvf as [vf|]; simplify_res; last first. | ||
2591 | { exists (<[x:=Thunk ∅ e']> ts). rewrite !fmap_insert /= subst_env_empty. | ||
2592 | destruct He'. split_and!. | ||
2593 | * eapply SAttr_lookup_rtc; [done..|]. | ||
2594 | etrans; [by apply steps_shallow_any|done]. | ||
2595 | * apply Attr_nf_insert; auto. | ||
2596 | intros y. rewrite lookup_fmap fmap_is_Some. eauto. | ||
2597 | * rewrite map_Forall_insert //= subst_env_empty. naive_solver. } | ||
2598 | destruct (map_mapM_sorted _ _ _) as [mvs|] eqn:Hmap'; simplify_res. | ||
2599 | destruct (IH _ eq_refl) as (ts' & Hsteps'' & Hts'). | ||
2600 | exists (<[x:=Forced vf]> ts'). split. | ||
2601 | { rewrite !fmap_insert /=. | ||
2602 | etrans; [eapply SAttr_lookup_rtc; [done..|]; | ||
2603 | etrans; [by apply steps_shallow_any|done]|]. | ||
2604 | eapply Attr_steps_insert; by eauto using final_force_deep. } | ||
2605 | destruct mvs as [vs|]; simplify_res. | ||
2606 | { by rewrite !fmap_insert Hts'. } | ||
2607 | assert (∀ y, ts !! y = None ↔ ts' !! y = None) as Hdom. | ||
2608 | { intros y. rewrite -!(fmap_None (AttrN ∘ thunk_to_expr)). | ||
2609 | rewrite -!lookup_fmap. by eapply Attr_steps_dom. } | ||
2610 | split; [|rewrite map_Forall_insert; naive_solver]. | ||
2611 | rewrite fmap_insert /=. apply Attr_nf_insert_final; | ||
2612 | eauto using final_force_deep. | ||
2613 | * rewrite lookup_fmap fmap_None. naive_solver. | ||
2614 | * intros y. rewrite lookup_fmap fmap_is_Some. | ||
2615 | rewrite -not_eq_None_Some -Hdom not_eq_None_Some. auto. | ||
2616 | * naive_solver. | ||
2617 | Qed. | ||
2618 | |||
2619 | Lemma interp_sound_open' n μ E e mv : | ||
2620 | interp' n μ E e = Res mv → | ||
2621 | ∃ e', subst_env E e -{μ}->* e' ∧ | ||
2622 | if mv is Some v' then e' = val_to_expr v' else stuck μ e'. | ||
2623 | Proof. | ||
2624 | intros Hinterp. destruct μ. | ||
2625 | { rewrite interp_shallow' in Hinterp. by eapply interp_sound_open. } | ||
2626 | rewrite /interp' /= in Hinterp. | ||
2627 | destruct (interp n E e) as [mv'|] eqn:Hinterp'; simplify_res. | ||
2628 | apply interp_sound_open in Hinterp' as (e' & Hsteps & He'). | ||
2629 | destruct mv' as [v'|]; simplify_res; last first. | ||
2630 | { eauto using steps_shallow_any, stuck_shallow_any. } | ||
2631 | eapply force_deep_sound in Hinterp as (e'' & Hsteps' & He''). | ||
2632 | eexists; split; [|done]. etrans; [by eapply steps_shallow_any|done]. | ||
2633 | Qed. | ||
2634 | |||
2635 | Lemma interp_sound n μ e mv : | ||
2636 | interp' n μ ∅ e = Res mv → | ||
2637 | ∃ e', e -{μ}->* e' ∧ | ||
2638 | if mv is Some v then e' = val_to_expr v else stuck μ e'. | ||
2639 | Proof. | ||
2640 | intros Hsteps%interp_sound_open'. by rewrite subst_env_empty in Hsteps. | ||
2641 | Qed. | ||
2642 | |||
2643 | (** Final theorems *) | ||
2644 | Theorem interp_sound_complete_ret e v : | ||
2645 | (∃ w n, interp' n SHALLOW ∅ e = mret w ∧ val_to_expr v = val_to_expr w) | ||
2646 | ↔ e -{SHALLOW}->* val_to_expr v. | ||
2647 | Proof. | ||
2648 | split. | ||
2649 | - by intros (n & w & (e' & ? & ->)%interp_sound & ->). | ||
2650 | - intros Hsteps. apply interp_complete in Hsteps as ([] & ? & ? & ?); | ||
2651 | unfold nf, red; | ||
2652 | naive_solver eauto using final_val_to_expr, step_not_val_to_expr. | ||
2653 | Qed. | ||
2654 | |||
2655 | Theorem interp_sound_complete_ret_lit μ e bl (Hbl : base_lit_ok bl) : | ||
2656 | (∃ n, interp' n μ ∅ e = mret (VLit bl Hbl)) ↔ e -{μ}->* ELit bl. | ||
2657 | Proof. | ||
2658 | split. | ||
2659 | - intros [n (e' & ? & ->)%interp_sound]. done. | ||
2660 | - intros Hsteps. apply interp_complete_ret in Hsteps | ||
2661 | as ([] & n & ? & Hv); simplify_eq/=; last by constructor. | ||
2662 | exists n. by rewrite (proof_irrel Hbl Hbl0). | ||
2663 | Qed. | ||
2664 | |||
2665 | Theorem interp_sound_complete_fail μ e : | ||
2666 | (∃ n, interp' n μ ∅ e = mfail) ↔ ∃ e', e -{μ}->* e' ∧ stuck μ e'. | ||
2667 | Proof. | ||
2668 | split. | ||
2669 | - by intros [n ?%interp_sound]. | ||
2670 | - intros (e' & Hsteps & Hnf & Hfinal). by eapply interp_complete_fail. | ||
2671 | Qed. | ||
2672 | |||
2673 | Theorem interp_sound_complete_no_fuel μ e : | ||
2674 | (∀ n, interp' n μ ∅ e = NoFuel) ↔ all_loop (step μ) e. | ||
2675 | Proof. | ||
2676 | rewrite all_loop_alt. split. | ||
2677 | - intros Hnofuel e' Hsteps. | ||
2678 | destruct (red_final_interp μ e') as [|[|He']]; [done|..]. | ||
2679 | + apply interp_complete_ret in Hsteps as (w & m & Hinterp & _); last done. | ||
2680 | by rewrite Hnofuel in Hinterp. | ||
2681 | + apply interp_sound_complete_fail in He' as (e'' & ? & [Hnf _]). | ||
2682 | destruct (interp_complete μ e e'') | ||
2683 | as (mv & n & Hinterp & _); [by etrans|done|]. | ||
2684 | by rewrite Hnofuel in Hinterp. | ||
2685 | - intros Hred n. destruct (interp' n μ ∅ e) as [mv|] eqn:Hinterp; [|done]. | ||
2686 | destruct (interp_sound _ _ _ _ Hinterp) as (e' & Hsteps & Hstuck). | ||
2687 | destruct mv as [v|]; simplify_eq/=. | ||
2688 | + apply Hred in Hsteps as []%final_nf. by eapply final_val_to_expr'. | ||
2689 | + destruct Hstuck as [[] ?]; eauto. | ||
2690 | Qed. | ||
diff --git a/theories/nix/notations.v b/theories/nix/notations.v new file mode 100644 index 0000000..e9995b5 --- /dev/null +++ b/theories/nix/notations.v | |||
@@ -0,0 +1,43 @@ | |||
1 | From mininix Require Export nix.operational. | ||
2 | |||
3 | (* Influenced by | ||
4 | https://gitlab.mpi-sws.org/iris/iris/-/blob/master/iris_heap_lang/notation.v | ||
5 | But always uses ":" instead of a scope. *) | ||
6 | |||
7 | Coercion EId' : string >-> expr. | ||
8 | Coercion NInt : Z >-> num. | ||
9 | Coercion NFloat : float >-> num. | ||
10 | Coercion LitNum : num >-> base_lit. | ||
11 | Coercion LitBool : bool >-> base_lit. | ||
12 | Coercion ELit : base_lit >-> expr. | ||
13 | Coercion EApp : expr >-> Funclass. | ||
14 | |||
15 | Notation "λattr: a , e" := (EAbsMatch a true e) | ||
16 | (at level 200, e, a at level 200, | ||
17 | format "'[' 'λattr:' a , '/ ' e ']'"). | ||
18 | Notation "λattr: a .., e" := (EAbsMatch a false e) | ||
19 | (at level 200, e, a at level 200, | ||
20 | format "'[' 'λattr:' a .., '/ ' e ']'"). | ||
21 | |||
22 | Notation "λ: x .. y , e" := (EAbs x .. (EAbs y e) ..) | ||
23 | (at level 200, x, y at level 1, e at level 200, | ||
24 | format "'[' 'λ:' x .. y , '/ ' e ']'"). | ||
25 | Notation "'let:' x := e1 'in' e2" := (ELet x e1 e2) | ||
26 | (at level 200, x at level 1, e1, e2 at level 200, | ||
27 | format "'[' 'let:' x := '[' e1 ']' 'in' '/' e2 ']'"). | ||
28 | Notation "'with:' a 'in' e" := (EWith a e) | ||
29 | (at level 200, a, e at level 200, | ||
30 | format "'[' 'with:' a 'in' '/' e ']'"). | ||
31 | |||
32 | Notation "'if:' e1 'then' e2 'else' e3" := (EIf e1 e2 e3) | ||
33 | (at level 200, e1, e2, e3 at level 200). | ||
34 | |||
35 | Notation "e1 .: e2" := (ESelect e1 e2) (at level 70, no associativity). | ||
36 | |||
37 | Notation "e1 +: e2" := (EBinOp AddOp e1 e2) (at level 50, left associativity). | ||
38 | Notation "e1 *: e2" := (EBinOp MulOp e1 e2). | ||
39 | Notation "e1 -: e2" := (EBinOp SubOp e1 e2) (at level 50, left associativity). | ||
40 | Notation "e1 /: e2" := (EBinOp DivOp e1 e2) (at level 40). | ||
41 | Notation "e1 =: e2" := (EBinOp EqOp e1 e2) (at level 70, no associativity). | ||
42 | Notation "e1 <: e2" := (EBinOp LtOp e1 e2) (at level 70, no associativity). | ||
43 | Notation "'ceil:' e" := (EBinOp (RoundOp Ceil) e LitNull) (at level 10). | ||
diff --git a/theories/nix/operational.v b/theories/nix/operational.v new file mode 100644 index 0000000..d3f0777 --- /dev/null +++ b/theories/nix/operational.v | |||
@@ -0,0 +1,527 @@ | |||
1 | From mininix Require Export utils nix.floats. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | (** Our development does not rely on a particular order on attribute set names. | ||
5 | It can be any decidable total order. We pick something concrete (lexicographic | ||
6 | order on strings) to avoid having to parametrize the whole development. *) | ||
7 | Definition attr_le := String.le. | ||
8 | Global Instance attr_le_dec : RelDecision attr_le := _. | ||
9 | Global Instance attr_le_po : PartialOrder attr_le := _. | ||
10 | Global Instance attr_le_total : Total attr_le := _. | ||
11 | Global Typeclasses Opaque attr_le. | ||
12 | |||
13 | Inductive mode := SHALLOW | DEEP. | ||
14 | Inductive kind := ABS | WITH. | ||
15 | Inductive rec := REC | NONREC. | ||
16 | |||
17 | Global Instance rec_eq_dec : EqDecision rec. | ||
18 | Proof. solve_decision. Defined. | ||
19 | |||
20 | Inductive num := | ||
21 | | NInt (n : Z) | ||
22 | | NFloat (f : float). | ||
23 | |||
24 | Inductive base_lit := | ||
25 | | LitNum (n : num) | ||
26 | | LitBool (b : bool) | ||
27 | | LitString (s : string) | ||
28 | | LitNull. | ||
29 | |||
30 | Global Instance num_inhabited : Inhabited num := populate (NInt 0). | ||
31 | Global Instance base_lit_inhabited : Inhabited base_lit := populate LitNull. | ||
32 | |||
33 | Global Instance num_eq_dec : EqDecision num. | ||
34 | Proof. solve_decision. Defined. | ||
35 | Global Instance base_lit_eq_dec : EqDecision base_lit. | ||
36 | Proof. solve_decision. Defined. | ||
37 | |||
38 | Global Instance maybe_NInt : Maybe NInt := λ n, | ||
39 | if n is NInt i then Some i else None. | ||
40 | Global Instance maybe_NFloat : Maybe NFloat := λ n, | ||
41 | if n is NFloat f then Some f else None. | ||
42 | Global Instance maybe_LitNum : Maybe LitNum := λ bl, | ||
43 | if bl is LitNum n then Some n else None. | ||
44 | Global Instance maybe_LitBool : Maybe LitBool := λ bl, | ||
45 | if bl is LitBool b then Some b else None. | ||
46 | Global Instance maybe_LitString : Maybe LitString := λ bl, | ||
47 | if bl is LitString s then Some s else None. | ||
48 | |||
49 | Inductive bin_op : Set := | ||
50 | | AddOp | SubOp | MulOp | DivOp | AndOp | OrOp | XOrOp (* Arithmetic *) | ||
51 | | LtOp | EqOp (* Relations *) | ||
52 | | RoundOp (m : round_mode) (* Conversions *) | ||
53 | | MatchStringOp (* Strings *) | ||
54 | | MatchListOp | AppendListOp (* Lists *) | ||
55 | | SelectAttrOp | UpdateAttrOp | HasAttrOp | ||
56 | | DeleteAttrOp | SingletonAttrOp | MatchAttrOp (* Attribute sets *) | ||
57 | | FunctionArgsOp | TypeOfOp. | ||
58 | |||
59 | Global Instance bin_op_eq_dec : EqDecision bin_op. | ||
60 | Proof. solve_decision. Defined. | ||
61 | |||
62 | Global Instance maybe_RoundOp : Maybe RoundOp := λ op, | ||
63 | if op is RoundOp m then Some m else None. | ||
64 | |||
65 | Section expr. | ||
66 | Local Unset Elimination Schemes. | ||
67 | Inductive expr := | ||
68 | | ELit (bl : base_lit) | ||
69 | | EId (x : string) (mke : option (kind * expr)) | ||
70 | | EAbs (x : string) (e : expr) | ||
71 | | EAbsMatch (ms : gmap string (option expr)) (strict : bool) (e : expr) | ||
72 | | EApp (e1 e2 : expr) | ||
73 | | ESeq (μ : mode) (e1 e2 : expr) | ||
74 | | EList (es : list expr) | ||
75 | | EAttr (αs : gmap string attr) | ||
76 | | ELetAttr (k : kind) (e1 e2 : expr) | ||
77 | | EBinOp (op : bin_op) (e1 e2 : expr) | ||
78 | | EIf (e1 e2 e3 : expr) | ||
79 | with attr := | ||
80 | | Attr (τ : rec) (e : expr). | ||
81 | End expr. | ||
82 | |||
83 | Definition EId' x := EId x None. | ||
84 | Notation AttrR := (Attr REC). | ||
85 | Notation AttrN := (Attr NONREC). | ||
86 | Notation ESelect e x := (EBinOp SelectAttrOp e (ELit (LitString x))). | ||
87 | Notation ELet x e := (ELetAttr ABS (EAttr {[ x := AttrN e ]})). | ||
88 | Notation EWith := (ELetAttr WITH). | ||
89 | |||
90 | Definition attr_expr (α : attr) : expr := match α with Attr _ e => e end. | ||
91 | Definition attr_rec (α : attr) : rec := match α with Attr μ _ => μ end. | ||
92 | Definition attr_map (f : expr → expr) (α : attr) : attr := | ||
93 | match α with Attr μ e => Attr μ (f e) end. | ||
94 | |||
95 | Definition from_attr {A} (f g : expr → A) (α : attr) : A := | ||
96 | match α with AttrR e => f e | AttrN e => g e end. | ||
97 | |||
98 | Definition merge_kinded {A} (new old : kind * A) : option (kind * A) := | ||
99 | match new.1, old.1 with | ||
100 | | WITH, ABS => Some old | ||
101 | | _, _ => Some new | ||
102 | end. | ||
103 | Arguments merge_kinded {_} !_ !_ / : simpl nomatch. | ||
104 | Notation union_kinded := (union_with merge_kinded). | ||
105 | |||
106 | Definition no_recs : gmap string attr → Prop := | ||
107 | map_Forall (λ _ α, attr_rec α = NONREC). | ||
108 | |||
109 | Definition indirects (αs : gmap string attr) : gmap string (kind * expr) := | ||
110 | map_imap (λ x _, Some (ABS, ESelect (EAttr αs) x)) αs. | ||
111 | |||
112 | Fixpoint subst (ds : gmap string (kind * expr)) (e : expr) : expr := | ||
113 | match e with | ||
114 | | ELit b => ELit b | ||
115 | | EId x mkd => EId x $ union_kinded (ds !! x) mkd | ||
116 | | EAbs x e => EAbs x (subst ds e) | ||
117 | | EAbsMatch ms strict e => | ||
118 | EAbsMatch (fmap (M:=option) (subst ds) <$> ms) strict (subst ds e) | ||
119 | | EApp e1 e2 => EApp (subst ds e1) (subst ds e2) | ||
120 | | ESeq μ e1 e2 => ESeq μ (subst ds e1) (subst ds e2) | ||
121 | | EList es => EList (subst ds <$> es) | ||
122 | | EAttr αs => EAttr (attr_map (subst ds) <$> αs) | ||
123 | | ELetAttr k e1 e2 => ELetAttr k (subst ds e1) (subst ds e2) | ||
124 | | EBinOp op e1 e2 => EBinOp op (subst ds e1) (subst ds e2) | ||
125 | | EIf e1 e2 e3 => EIf (subst ds e1) (subst ds e2) (subst ds e3) | ||
126 | end. | ||
127 | |||
128 | Notation attr_subst ds := (attr_map (subst ds)). | ||
129 | |||
130 | Definition int_min : Z := -(1 ≪ 63). | ||
131 | Definition int_max : Z := 1 ≪ 63 - 1. | ||
132 | |||
133 | Definition int_ok (i : Z) : bool := bool_decide (int_min ≤ i ≤ int_max)%Z. | ||
134 | Definition num_ok (n : num) : bool := | ||
135 | match n with NInt i => int_ok i | _ => true end. | ||
136 | Definition base_lit_ok (bl : base_lit) : bool := | ||
137 | match bl with LitNum n => num_ok n | _ => true end. | ||
138 | |||
139 | Inductive final : mode → expr → Prop := | ||
140 | | ELitFinal μ bl : base_lit_ok bl → final μ (ELit bl) | ||
141 | | EAbsFinal μ x e : final μ (EAbs x e) | ||
142 | | EAbsMatchFinal μ ms strict e : final μ (EAbsMatch ms strict e) | ||
143 | | EListShallowFinal es : final SHALLOW (EList es) | ||
144 | | EListDeepFinal es : Forall (final DEEP) es → final DEEP (EList es) | ||
145 | | EAttrShallowFinal αs : no_recs αs → final SHALLOW (EAttr αs) | ||
146 | | EAttrDeepFinal αs : | ||
147 | no_recs αs → | ||
148 | map_Forall (λ _, final DEEP ∘ attr_expr) αs → | ||
149 | final DEEP (EAttr αs). | ||
150 | |||
151 | Fixpoint sem_eq_list (es1 es2 : list expr) : expr := | ||
152 | match es1, es2 with | ||
153 | | [], [] => ELit (LitBool true) | ||
154 | | e1 :: es1, e2 :: es2 => | ||
155 | EIf (EBinOp EqOp e1 e2) (sem_eq_list es1 es2) (ELit (LitBool false)) | ||
156 | | _, _ => ELit (LitBool false) | ||
157 | end. | ||
158 | |||
159 | Fixpoint sem_lt_list (es1 es2 : list expr) : expr := | ||
160 | match es1, es2 with | ||
161 | | [], _ => ELit (LitBool true) | ||
162 | | e1 :: es1, e2 :: es2 => | ||
163 | EIf (EBinOp LtOp e1 e2) (ELit (LitBool true)) $ | ||
164 | EIf (EBinOp EqOp e1 e2) (sem_lt_list es1 es2) (ELit (LitBool false)) | ||
165 | | _ :: _, [] => ELit (LitBool false) | ||
166 | end. | ||
167 | |||
168 | Definition sem_and_attr (es : gmap string expr) : expr := | ||
169 | map_fold_sorted attr_le | ||
170 | (λ _ e1 e2, EIf e1 e2 (ELit (LitBool false))) | ||
171 | (ELit (LitBool true)) es. | ||
172 | |||
173 | Definition sem_eq_attr (αs1 αs2 : gmap string attr) : expr := | ||
174 | sem_and_attr $ merge (λ mα1 mα2, | ||
175 | α1 ← mα1; α2 ← mα2; Some (EBinOp EqOp (attr_expr α1) (attr_expr α2))) αs1 αs2. | ||
176 | |||
177 | Definition num_to_float (n : num) : float := | ||
178 | match n with | ||
179 | | NInt i => Float.of_Z i | ||
180 | | NFloat f => f | ||
181 | end. | ||
182 | |||
183 | Definition sem_bin_op_lift | ||
184 | (fint : Z → Z → Z) (ffloat : float → float → float) | ||
185 | (n1 n2 : num) : option num := | ||
186 | match n1, n2 with | ||
187 | | NInt i1, NInt i2 => | ||
188 | let i := fint i1 i2 in | ||
189 | guard (int_ok i);; | ||
190 | Some (NInt i) | ||
191 | | _, _ => Some $ NFloat $ ffloat (num_to_float n1) (num_to_float n2) | ||
192 | end. | ||
193 | |||
194 | Definition sem_bin_rel_lift | ||
195 | (fint : Z → Z → bool) (ffloat : float → float → bool) | ||
196 | (n1 n2 : num) : bool := | ||
197 | match n1, n2 with | ||
198 | | NInt i1, NInt i2 => fint i1 i2 | ||
199 | | _, _ => ffloat (num_to_float n1) (num_to_float n2) | ||
200 | end. | ||
201 | |||
202 | Definition sem_eq_base_lit (bl1 bl2 : base_lit) : bool := | ||
203 | match bl1, bl2 with | ||
204 | | LitNum n1, LitNum n2 => sem_bin_rel_lift Z.eqb Float.eqb n1 n2 | ||
205 | | LitBool b1, LitBool b2 => bool_decide (b1 = b2) | ||
206 | | LitString s1, LitString s2 => bool_decide (s1 = s2) | ||
207 | | LitNull, LitNull => true | ||
208 | | _, _ => false | ||
209 | end. | ||
210 | |||
211 | (** Precondition e1 and e2 are final *) | ||
212 | Definition sem_eq (e1 e2 : expr) : option expr := | ||
213 | match e1, e2 with | ||
214 | | ELit bl1, ELit bl2 => Some $ ELit (LitBool (sem_eq_base_lit bl1 bl2)) | ||
215 | | EAbs _ _, EAbs _ _ => None | ||
216 | | EList es1, EList es2 => Some $ | ||
217 | if decide (length es1 = length es2) then sem_eq_list es1 es2 | ||
218 | else ELit $ LitBool false | ||
219 | | EAttr αs1, EAttr αs2 => Some $ | ||
220 | if decide (dom αs1 = dom αs2) then sem_eq_attr αs1 αs2 | ||
221 | else ELit $ LitBool false | ||
222 | | _, _ => Some $ ELit (LitBool false) | ||
223 | end. | ||
224 | |||
225 | Definition div_allowed (n : num) : bool := | ||
226 | match n with | ||
227 | | NInt n => bool_decide (n ≠ 0%Z) | ||
228 | | NFloat f => negb (Float.eqb f (Float.of_Z 0)) (* TODO: Check NaNs *) | ||
229 | end. | ||
230 | |||
231 | Definition sem_bin_op_num (op : bin_op) (n1 : num) : option (num → option base_lit) := | ||
232 | match op with | ||
233 | | AddOp => Some $ λ n2, | ||
234 | LitNum <$> sem_bin_op_lift Z.add Float.add n1 n2 | ||
235 | | SubOp => Some $ λ n2, | ||
236 | LitNum <$> sem_bin_op_lift Z.sub Float.sub n1 n2 | ||
237 | | MulOp => Some $ λ n2, | ||
238 | LitNum <$> sem_bin_op_lift Z.mul Float.mul n1 n2 | ||
239 | | DivOp => Some $ λ n2, | ||
240 | (* Quot can overflow: [MIN_INT `quot` -1] equals [MAX_INT + 1] *) | ||
241 | guard (div_allowed n2);; | ||
242 | LitNum <$> sem_bin_op_lift Z.quot Float.div n1 n2 | ||
243 | | AndOp => | ||
244 | i1 ← maybe NInt n1; | ||
245 | Some $ λ n2, i2 ← maybe NInt n2; | ||
246 | Some $ LitNum $ NInt $ Z.land i1 i2 | ||
247 | | OrOp => | ||
248 | i1 ← maybe NInt n1; | ||
249 | Some $ λ n2, i2 ← maybe NInt n2; | ||
250 | Some $ LitNum $ NInt $ Z.lor i1 i2 | ||
251 | | XOrOp => | ||
252 | i1 ← maybe NInt n1; | ||
253 | Some $ λ n2, i2 ← maybe NInt n2; | ||
254 | Some $ LitNum $ NInt $ Z.lxor i1 i2 | ||
255 | | LtOp => Some $ λ n2, | ||
256 | Some $ LitBool (sem_bin_rel_lift Z.ltb Float.ltb n1 n2) | ||
257 | | _ => None | ||
258 | end%Z. | ||
259 | |||
260 | Definition sem_bin_op_string (op : bin_op) : option (string → string → base_lit) := | ||
261 | match op with | ||
262 | | AddOp => Some $ λ s1 s2, LitString (s1 +:+ s2) | ||
263 | | LtOp => Some $ λ s1 s2, LitBool (bool_decide (strict attr_le s1 s2)) | ||
264 | | _ => None | ||
265 | end. | ||
266 | |||
267 | Definition type_of_num (n : num) : string := | ||
268 | match n with | ||
269 | | NInt _ => "int" | ||
270 | | NFloat _ => "float" | ||
271 | end. | ||
272 | |||
273 | Definition type_of_base_lit (bl : base_lit) : string := | ||
274 | match bl with | ||
275 | | LitNum n => type_of_num n | ||
276 | | LitBool _ => "bool" | ||
277 | | LitString _ => "string" | ||
278 | | LitNull => "null" | ||
279 | end. | ||
280 | |||
281 | Definition type_of_expr (e : expr) := | ||
282 | match e with | ||
283 | | ELit bl => Some (type_of_base_lit bl) | ||
284 | | EAbs _ _ | EAbsMatch _ _ _ => Some "lambda" | ||
285 | | EList _ => Some "list" | ||
286 | | EAttr _ => Some "set" | ||
287 | | _ => None | ||
288 | end. | ||
289 | |||
290 | (* Used for [RoundOp] *) | ||
291 | Definition float_to_bounded_Z (f : float) : Z := | ||
292 | match Float.to_Z f with | ||
293 | | Some x => if decide (int_ok x) then x else int_min | ||
294 | | None => int_min | ||
295 | end. | ||
296 | |||
297 | Inductive sem_bin_op : bin_op → expr → (expr → expr → Prop) → Prop := | ||
298 | | EqSem e1 : | ||
299 | sem_bin_op EqOp e1 (λ e2 e, sem_eq e1 e2 = Some e) | ||
300 | | LitNumSem op n1 f : | ||
301 | sem_bin_op_num op n1 = Some f → | ||
302 | sem_bin_op op (ELit (LitNum n1)) (λ e2 e, ∃ n2 bl, | ||
303 | e2 = ELit (LitNum n2) ∧ f n2 = Some bl ∧ e = ELit bl) | ||
304 | | RoundSem m n1 : | ||
305 | sem_bin_op (RoundOp m) (ELit (LitNum n1)) (λ e2 e, | ||
306 | e2 = ELit LitNull ∧ | ||
307 | e = ELit $ LitNum $ NInt $ float_to_bounded_Z $ Float.round m $ num_to_float n1) | ||
308 | | LitStringSem op s1 f : | ||
309 | sem_bin_op_string op = Some f → | ||
310 | sem_bin_op op (ELit (LitString s1)) (λ e2 e, ∃ s2, | ||
311 | e2 = ELit (LitString s2) ∧ e = ELit (f s1 s2)) | ||
312 | | MatchStringSem s : | ||
313 | sem_bin_op MatchStringOp (ELit (LitString s)) (λ e2 e, | ||
314 | e2 = ELit LitNull ∧ | ||
315 | match s with | ||
316 | | EmptyString => e = EAttr {[ | ||
317 | "empty" := AttrN (ELit (LitBool true)); | ||
318 | "head" := AttrN (ELit LitNull); | ||
319 | "tail" := AttrN (ELit LitNull) ]} | ||
320 | | String a s => e = EAttr {[ | ||
321 | "empty" := AttrN (ELit (LitBool false)); | ||
322 | "head" := AttrN (ELit (LitString (String a EmptyString))); | ||
323 | "tail" := AttrN (ELit (LitString s)) ]} | ||
324 | end) | ||
325 | | LtListSem es : | ||
326 | sem_bin_op LtOp (EList es) (λ e2 e, ∃ es', | ||
327 | e2 = EList es' ∧ | ||
328 | e = sem_lt_list es es') | ||
329 | | MatchListSem es : | ||
330 | sem_bin_op MatchListOp (EList es) (λ e2 e, | ||
331 | e2 = ELit LitNull ∧ | ||
332 | match es with | ||
333 | | [] => e = EAttr {[ | ||
334 | "empty" := AttrN (ELit (LitBool true)); | ||
335 | "head" := AttrN (ELit LitNull); | ||
336 | "tail" := AttrN (ELit LitNull) ]} | ||
337 | | e' :: es => e = EAttr {[ | ||
338 | "empty" := AttrN (ELit (LitBool false)); | ||
339 | "head" := AttrN e'; | ||
340 | "tail" := AttrN (EList es) ]} | ||
341 | end) | ||
342 | | AppendListSem es : | ||
343 | sem_bin_op AppendListOp (EList es) (λ e2 e, ∃ es', | ||
344 | e2 = EList es' ∧ | ||
345 | e = EList (es ++ es')) | ||
346 | | SelectAttrSem αs : | ||
347 | no_recs αs → | ||
348 | sem_bin_op SelectAttrOp (EAttr αs) (λ e2 e, ∃ x, | ||
349 | e2 = ELit (LitString x) ∧ αs !! x = Some (AttrN e)) | ||
350 | | UpdateAttrSem αs1 : | ||
351 | no_recs αs1 → | ||
352 | sem_bin_op UpdateAttrOp (EAttr αs1) (λ e2 e, ∃ αs2, | ||
353 | e2 = EAttr αs2 ∧ no_recs αs2 ∧ e = EAttr (αs2 ∪ αs1)) | ||
354 | | HasAttrSem αs : | ||
355 | no_recs αs → | ||
356 | sem_bin_op HasAttrOp (EAttr αs) (λ e2 e, ∃ x, | ||
357 | e2 = ELit (LitString x) ∧ e = ELit (LitBool (bool_decide (is_Some (αs !! x))))) | ||
358 | | DeleteAttrSem αs : | ||
359 | no_recs αs → | ||
360 | sem_bin_op DeleteAttrOp (EAttr αs) (λ e2 e, ∃ x, | ||
361 | e2 = ELit (LitString x) ∧ e = EAttr (delete x αs)) | ||
362 | | SingletonAttrSem x : | ||
363 | sem_bin_op SingletonAttrOp (ELit (LitString x)) (λ e2 e, | ||
364 | e2 = ELit LitNull ∧ | ||
365 | e = EAbs "t" (EAttr {[ x := AttrN (EId' "t") ]})) | ||
366 | | MatchAttrSem αs : | ||
367 | no_recs αs → | ||
368 | sem_bin_op MatchAttrOp (EAttr αs) (λ e2 e, | ||
369 | e2 = ELit LitNull ∧ | ||
370 | ((αs = ∅ ∧ | ||
371 | e = EAttr {[ | ||
372 | "empty" := AttrN (ELit (LitBool true)); | ||
373 | "key" := AttrN (ELit LitNull); | ||
374 | "head" := AttrN (ELit LitNull); | ||
375 | "tail" := AttrN (ELit LitNull) ]}) ∨ | ||
376 | (∃ x e', | ||
377 | αs !! x = Some (AttrN e') ∧ | ||
378 | (∀ y, is_Some (αs !! y) → attr_le x y) ∧ | ||
379 | e = EAttr {[ | ||
380 | "empty" := AttrN (ELit (LitBool false)); | ||
381 | "key" := AttrN (ELit (LitString x)); | ||
382 | "head" := AttrN e'; | ||
383 | "tail" := AttrN (EAttr (delete x αs)) ]}))) | ||
384 | | FunctionArgsAbsSem x e' : | ||
385 | sem_bin_op FunctionArgsOp (EAbs x e') (λ e2 e, | ||
386 | e2 = ELit LitNull ∧ | ||
387 | e = EAttr ∅) | ||
388 | | FunctionArgsAbsMatchSem ms strict e' : | ||
389 | sem_bin_op FunctionArgsOp (EAbsMatch ms strict e') (λ e2 e, | ||
390 | e2 = ELit LitNull ∧ | ||
391 | e = EAttr (AttrN ∘ ELit ∘ LitBool ∘ from_option (λ _, true) false <$> ms)) | ||
392 | | TypeOfSem e1 : | ||
393 | sem_bin_op TypeOfOp e1 (λ e2 e, ∃ x, | ||
394 | e2 = ELit LitNull ∧ | ||
395 | type_of_expr e1 = Some x ∧ | ||
396 | e = ELit (LitString x)). | ||
397 | |||
398 | Inductive matches : | ||
399 | gmap string expr → gmap string (option expr) → bool → gmap string attr → Prop := | ||
400 | | MatchEmpty strict : | ||
401 | matches ∅ ∅ strict ∅ | ||
402 | | MatchAny es : | ||
403 | matches es ∅ false ∅ | ||
404 | | MatchAvail x e es ms md strict βs : | ||
405 | es !! x = None → | ||
406 | ms !! x = None → | ||
407 | matches es ms strict βs → | ||
408 | matches (<[x:=e]> es) (<[x:=md]> ms) strict (<[x:=AttrN e]> βs) | ||
409 | | MatchOptDefault x es ms d strict βs : | ||
410 | es !! x = None → | ||
411 | ms !! x = None → | ||
412 | matches es ms strict βs → | ||
413 | matches es (<[x:=Some d]> ms) strict (<[x:=AttrR d]> βs). | ||
414 | |||
415 | Reserved Notation "e1 -{ μ }-> e2" | ||
416 | (right associativity, at level 55, μ at level 1, format "e1 -{ μ }-> e2"). | ||
417 | |||
418 | Inductive ctx1 : mode → mode → (expr → expr) → Prop := | ||
419 | | CList es1 es2 : | ||
420 | Forall (final DEEP) es1 → | ||
421 | ctx1 DEEP DEEP (λ e, EList (es1 ++ e :: es2)) | ||
422 | | CAttr αs x : | ||
423 | no_recs αs → | ||
424 | αs !! x = None → | ||
425 | (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) → | ||
426 | ctx1 DEEP DEEP (λ e, EAttr (<[x:=AttrN e]> αs)) | ||
427 | | CAppL μ e2 : | ||
428 | ctx1 SHALLOW μ (λ e1, EApp e1 e2) | ||
429 | | CAppR μ ms strict e1 : | ||
430 | ctx1 SHALLOW μ (EApp (EAbsMatch ms strict e1)) | ||
431 | | CSeq μ μ' e2 : | ||
432 | ctx1 μ' μ (λ e1, ESeq μ' e1 e2) | ||
433 | | CLetAttr μ k e2 : | ||
434 | ctx1 SHALLOW μ (λ e1, ELetAttr k e1 e2) | ||
435 | | CBinOpL μ op e2 : | ||
436 | ctx1 SHALLOW μ (λ e1, EBinOp op e1 e2) | ||
437 | | CBinOpR μ op e1 Φ : | ||
438 | final SHALLOW e1 → | ||
439 | sem_bin_op op e1 Φ → | ||
440 | ctx1 SHALLOW μ (EBinOp op e1) | ||
441 | | CIf μ e2 e3 : | ||
442 | ctx1 SHALLOW μ (λ e1, EIf e1 e2 e3). | ||
443 | |||
444 | Inductive step : mode → relation expr := | ||
445 | | Sβ μ x e1 e2 : | ||
446 | EApp (EAbs x e1) e2 -{μ}-> subst {[x:=(ABS, e2)]} e1 | ||
447 | | SβMatch μ ms strict e1 αs βs : | ||
448 | no_recs αs → | ||
449 | matches (attr_expr <$> αs) ms strict βs → | ||
450 | EApp (EAbsMatch ms strict e1) (EAttr αs) -{μ}-> | ||
451 | subst (indirects βs) e1 | ||
452 | | SFunctor μ αs e1 e2 : | ||
453 | no_recs αs → | ||
454 | αs !! "__functor" = Some (AttrN e1) → | ||
455 | EApp (EAttr αs) e2 -{μ}-> EApp (EApp e1 (EAttr αs)) e2 | ||
456 | | SSeqFinal μ μ' e1 e2 : | ||
457 | final μ' e1 → ESeq μ' e1 e2 -{μ}-> e2 | ||
458 | | SLetAttrAttr μ k αs e : | ||
459 | no_recs αs → | ||
460 | ELetAttr k (EAttr αs) e -{μ}-> subst ((k,.) ∘ attr_expr <$> αs) e | ||
461 | | SAttr_rec μ αs : | ||
462 | ¬no_recs αs → | ||
463 | EAttr αs -{μ}-> | ||
464 | EAttr (AttrN ∘ from_attr (subst (indirects αs)) id <$> αs) | ||
465 | | SBinOp μ op e1 Φ e2 e : | ||
466 | final SHALLOW e1 → | ||
467 | final SHALLOW e2 → | ||
468 | sem_bin_op op e1 Φ → Φ e2 e → | ||
469 | EBinOp op e1 e2 -{μ}-> e | ||
470 | | SIfBool μ b e2 e3 : | ||
471 | EIf (ELit (LitBool b)) e2 e3 -{μ}-> if b then e2 else e3 | ||
472 | | SId μ x k e : | ||
473 | EId x (Some (k,e)) -{μ}-> e | ||
474 | | SCtx K μ μ' e e' : | ||
475 | ctx1 μ μ' K → e -{μ}-> e' → K e -{μ'}-> K e' | ||
476 | where "e1 -{ μ }-> e2" := (step μ e1 e2). | ||
477 | |||
478 | Notation "e1 -{ μ }->* e2" := (rtc (step μ) e1 e2) | ||
479 | (right associativity, at level 55, μ at level 1, format "e1 -{ μ }->* e2"). | ||
480 | Notation "e1 -{ μ }->+ e2" := (tc (step μ) e1 e2) | ||
481 | (right associativity, at level 55, μ at level 1, format "e1 -{ μ }->+ e2"). | ||
482 | |||
483 | Definition stuck (μ : mode) (e : expr) : Prop := | ||
484 | nf (step μ) e ∧ ¬final μ e. | ||
485 | |||
486 | (** Induction *) | ||
487 | Fixpoint expr_size (e : expr) : nat := | ||
488 | match e with | ||
489 | | ELit _ => 1 | ||
490 | | EId _ mkd => S (from_option (expr_size ∘ snd) 1 mkd) | ||
491 | | EAbs _ d => S (expr_size d) | ||
492 | | EAbsMatch ms _ e => | ||
493 | S (map_sum_with (from_option expr_size 1) ms + expr_size e) | ||
494 | | EApp e1 e2 | ESeq _ e1 e2 => S (expr_size e1 + expr_size e2) | ||
495 | | EList es => S (sum_list_with expr_size es) | ||
496 | | EAttr eτs => S (map_sum_with (expr_size ∘ attr_expr) eτs) | ||
497 | | ELetAttr _ e1 e2 => S (expr_size e1 + expr_size e2) | ||
498 | | EBinOp _ e1 e2 => S (expr_size e1 + expr_size e2) | ||
499 | | EIf e1 e2 e3 => S (expr_size e1 + expr_size e2 + expr_size e3) | ||
500 | end. | ||
501 | |||
502 | Lemma expr_ind (P : expr → Prop) : | ||
503 | (∀ b, P (ELit b)) → | ||
504 | (∀ x mkd, from_option (P ∘ snd) True mkd → P (EId x mkd)) → | ||
505 | (∀ x e, P e → P (EAbs x e)) → | ||
506 | (∀ ms strict e, | ||
507 | map_Forall (λ _, from_option P True) ms → P e → P (EAbsMatch ms strict e)) → | ||
508 | (∀ e1 e2, P e1 → P e2 → P (EApp e1 e2)) → | ||
509 | (∀ μ e1 e2, P e1 → P e2 → P (ESeq μ e1 e2)) → | ||
510 | (∀ es, Forall P es → P (EList es)) → | ||
511 | (∀ αs, map_Forall (λ _, P ∘ attr_expr) αs → P (EAttr αs)) → | ||
512 | (∀ k e1 e2, P e1 → P e2 → P (ELetAttr k e1 e2)) → | ||
513 | (∀ op e1 e2, P e1 → P e2 → P (EBinOp op e1 e2)) → | ||
514 | (∀ e1 e2 e3, P e1 → P e2 → P e3 → P (EIf e1 e2 e3)) → | ||
515 | ∀ e, P e. | ||
516 | Proof. | ||
517 | intros Hlit Hid Habs Hmatch Happ Hseq Hlist Hattr Hlet Hop Hif e. | ||
518 | induction (Nat.lt_wf_0_projected expr_size e) as [e _ IH]. | ||
519 | destruct e; repeat destruct select (option _); simpl in *; eauto with lia. | ||
520 | - apply Hmatch; [|by eauto with lia]=> y [e'|] Hx //=. apply IH, Nat.lt_succ_r. | ||
521 | etrans; [|apply Nat.le_add_r]. | ||
522 | eapply (map_sum_with_lookup_le (from_option expr_size 1) _ _ _ Hx). | ||
523 | - apply Hlist, Forall_forall=> e ?. apply IH, Nat.lt_succ_r. | ||
524 | by apply sum_list_with_in. | ||
525 | - apply Hattr, map_Forall_lookup=> y e ?. apply IH, Nat.lt_succ_r. | ||
526 | by eapply (map_sum_with_lookup_le (expr_size ∘ attr_expr)). | ||
527 | Qed. | ||
diff --git a/theories/nix/operational_props.v b/theories/nix/operational_props.v new file mode 100644 index 0000000..4041bfe --- /dev/null +++ b/theories/nix/operational_props.v | |||
@@ -0,0 +1,680 @@ | |||
1 | From mininix Require Export utils nix.operational. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | (** Properties of operational semantics *) | ||
5 | Lemma float_to_bounded_Z_ok f : int_ok (float_to_bounded_Z f). | ||
6 | Proof. | ||
7 | rewrite /float_to_bounded_Z. | ||
8 | destruct (Float.to_Z f); simplify_option_eq; done. | ||
9 | Qed. | ||
10 | |||
11 | Lemma int_ok_alt i : | ||
12 | int_ok i ↔ ∀ n, (63 ≤ n)%Z → Z.testbit i n = bool_decide (i < 0)%Z. | ||
13 | Proof. | ||
14 | rewrite -Z.bounded_iff_bits //. | ||
15 | rewrite /int_ok bool_decide_spec /int_min /int_max Z.shiftl_1_l. lia. | ||
16 | Qed. | ||
17 | |||
18 | Lemma int_ok_land i1 i2 : int_ok i1 → int_ok i2 → int_ok (Z.land i1 i2). | ||
19 | Proof. | ||
20 | rewrite !int_ok_alt=> Hi1 Hi2 n ?. rewrite Z.land_spec Hi1 // Hi2 //. | ||
21 | apply eq_bool_prop_intro. rewrite andb_True !bool_decide_spec Z.land_neg //. | ||
22 | Qed. | ||
23 | |||
24 | Lemma int_ok_lor i1 i2 : int_ok i1 → int_ok i2 → int_ok (Z.lor i1 i2). | ||
25 | Proof. | ||
26 | rewrite !int_ok_alt=> Hi1 Hi2 n ?. rewrite Z.lor_spec Hi1 // Hi2 //. | ||
27 | apply eq_bool_prop_intro. rewrite orb_True !bool_decide_spec Z.lor_neg //. | ||
28 | Qed. | ||
29 | |||
30 | Lemma int_ok_lxor i1 i2 : int_ok i1 → int_ok i2 → int_ok (Z.lxor i1 i2). | ||
31 | Proof. | ||
32 | rewrite !int_ok_alt=> Hi1 Hi2 n ?. rewrite Z.lxor_spec Hi1 // Hi2 //. | ||
33 | apply eq_bool_prop_intro. rewrite xorb_True !bool_decide_spec. | ||
34 | rewrite !Z.lt_nge Z.lxor_nonneg. lia. | ||
35 | Qed. | ||
36 | |||
37 | Lemma sem_bin_op_num_ok {op f n1 n2 bl} : | ||
38 | num_ok n1 → num_ok n2 → | ||
39 | sem_bin_op_num op n1 = Some f → f n2 = Some bl → base_lit_ok bl. | ||
40 | Proof. | ||
41 | intros; destruct op, n1, n2; simplify_option_eq; | ||
42 | try (by apply (bool_decide_pack _)); | ||
43 | auto using int_ok_land, int_ok_lor, int_ok_lxor. | ||
44 | Qed. | ||
45 | |||
46 | Lemma sem_bin_op_string_ok {op f s1 s2} : | ||
47 | sem_bin_op_string op = Some f → base_lit_ok (f s1 s2). | ||
48 | Proof. intros; destruct op; naive_solver. Qed. | ||
49 | |||
50 | Global Hint Extern 0 (no_recs (_ <$> _)) => by apply map_Forall_fmap : core. | ||
51 | |||
52 | Ltac inv_step := repeat | ||
53 | match goal with | ||
54 | | H : ¬no_recs (_ <$> _) |- _ => destruct H; by apply map_Forall_fmap | ||
55 | | H : ?e -{_}-> _ |- _ => assert_succeeds (is_app_constructor e); inv H | ||
56 | | H : ctx1 _ _ ?K |- _ => is_var K; inv H | ||
57 | end. | ||
58 | |||
59 | Global Instance Attr_inj τ : Inj (=) (=) (Attr τ). | ||
60 | Proof. by injection 1. Qed. | ||
61 | |||
62 | Lemma fmap_attr_expr_Attr τ (es : gmap string expr) : | ||
63 | attr_expr <$> (Attr τ <$> es) = es. | ||
64 | Proof. apply map_eq=> x. rewrite !lookup_fmap. by destruct (_ !! _). Qed. | ||
65 | |||
66 | Lemma no_recs_insert αs x e : no_recs αs → no_recs (<[x:=AttrN e]> αs). | ||
67 | Proof. by apply map_Forall_insert_2. Qed. | ||
68 | Lemma no_recs_insert_inv αs x τ e : | ||
69 | αs !! x = None → no_recs (<[x:=Attr τ e]> αs) → no_recs αs. | ||
70 | Proof. intros ??%map_Forall_insert; naive_solver. Qed. | ||
71 | Lemma no_recs_lookup αs x τ e : no_recs αs → αs !! x = Some (Attr τ e) → τ = NONREC. | ||
72 | Proof. intros Hall. apply Hall. Qed. | ||
73 | |||
74 | Lemma no_recs_attr_subst αs ds : no_recs αs → no_recs (attr_subst ds <$> αs). | ||
75 | Proof. | ||
76 | intros. eapply map_Forall_fmap, map_Forall_impl; [done|]. by intros ? [[]] [=]. | ||
77 | Qed. | ||
78 | |||
79 | Lemma from_attr_no_recs {A} (f g : expr → A) (αs : gmap string attr) : | ||
80 | no_recs αs → from_attr f g <$> αs = g ∘ attr_expr <$> αs. | ||
81 | Proof. | ||
82 | intros Hrecs. apply map_eq=> x. rewrite !lookup_fmap. specialize (Hrecs x). | ||
83 | destruct (αs !! x) as [[]|] eqn:?; naive_solver. | ||
84 | Qed. | ||
85 | |||
86 | Lemma sem_and_attr_empty : sem_and_attr ∅ = ELit (LitBool true). | ||
87 | Proof. done. Qed. | ||
88 | Lemma sem_and_attr_insert es x e : | ||
89 | es !! x = None → (∀ y, is_Some (es !! y) → attr_le x y) → | ||
90 | sem_and_attr (<[x:=e]> es) = EIf e (sem_and_attr es) (ELit (LitBool false)). | ||
91 | Proof. intros. by rewrite /sem_and_attr map_fold_sorted_insert. Qed. | ||
92 | |||
93 | Lemma matches_strict es ms ds x e : | ||
94 | es !! x = None → | ||
95 | ms !! x = None → | ||
96 | matches es ms false ds → | ||
97 | matches (<[x:=e]> es) ms false ds. | ||
98 | Proof. | ||
99 | remember false as strict. | ||
100 | induction 3; simplify_eq/=; | ||
101 | repeat match goal with | ||
102 | | H : <[ _ := _ ]> _ !! _ = None |- _ => apply lookup_insert_None in H as [??] | ||
103 | | _ => rewrite (insert_commute _ x) // | ||
104 | | _ => constructor | ||
105 | | _ => apply lookup_insert_None | ||
106 | end; eauto. | ||
107 | Qed. | ||
108 | |||
109 | Lemma subst_empty e : subst ∅ e = e. | ||
110 | Proof. | ||
111 | induction e; repeat destruct select (option _); do 2 f_equal/=; auto. | ||
112 | - apply map_eq=> x. rewrite lookup_fmap. | ||
113 | destruct (_ !! x) as [[e'|]|] eqn:Hx; do 2 f_equal/=. apply (H _ _ Hx). | ||
114 | - induction H; f_equal/=; auto. | ||
115 | - apply map_eq; intros i. rewrite lookup_fmap. | ||
116 | destruct (_ !! i) as [[τ e]|] eqn:?; do 2 f_equal/=. | ||
117 | by eapply (H _ (Attr _ _)). | ||
118 | Qed. | ||
119 | |||
120 | Lemma subst_union ds1 ds2 e : | ||
121 | subst (union_kinded ds1 ds2) e = subst ds1 (subst ds2 e). | ||
122 | Proof. | ||
123 | revert ds1 ds2. induction e; intros ds1 ds2; f_equal/=; auto. | ||
124 | - rewrite lookup_union_with. | ||
125 | destruct mkd as [[[]]|], | ||
126 | (ds1 !! x) as [[[] t1]|], (ds2 !! x) as [[[] t2]|]; naive_solver. | ||
127 | - apply map_eq=> y. rewrite !lookup_fmap. | ||
128 | destruct (_ !! y) as [[e'|]|] eqn:Hy; do 2 f_equal/=. | ||
129 | rewrite -(H _ _ Hy) //. | ||
130 | - induction H; f_equal/=; auto. | ||
131 | - apply map_eq=> y. rewrite !lookup_fmap. | ||
132 | destruct (_ !! y) as [[τ e]|] eqn:Hy; do 2 f_equal/=. | ||
133 | rewrite -(H _ _ Hy) //. | ||
134 | Qed. | ||
135 | |||
136 | Lemma SAppL μ e1 e1' e2 : | ||
137 | e1 -{SHALLOW}-> e1' → EApp e1 e2 -{μ}-> EApp e1' e2. | ||
138 | Proof. apply (SCtx (λ e, EApp e _)). constructor. Qed. | ||
139 | Lemma SAppR μ ms strict e1 e2 e2' : | ||
140 | e2 -{SHALLOW}-> e2' → | ||
141 | EApp (EAbsMatch ms strict e1) e2 -{μ}-> EApp (EAbsMatch ms strict e1) e2'. | ||
142 | Proof. apply SCtx. constructor. Qed. | ||
143 | Lemma SSeq μ μ' e1 e1' e2 : | ||
144 | e1 -{μ'}-> e1' → ESeq μ' e1 e2 -{μ}-> ESeq μ' e1' e2. | ||
145 | Proof. apply (SCtx (λ e, ESeq _ e _)). constructor. Qed. | ||
146 | Lemma SList es1 e e' es2 : | ||
147 | Forall (final DEEP) es1 → | ||
148 | e -{DEEP}-> e' → | ||
149 | EList (es1 ++ e :: es2) -{DEEP}-> EList (es1 ++ e' :: es2). | ||
150 | Proof. intros ?. apply (SCtx (λ e, EList (_ ++ e :: _))). by constructor. Qed. | ||
151 | Lemma SAttr αs x e e' : | ||
152 | no_recs αs → | ||
153 | αs !! x = None → | ||
154 | (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) → | ||
155 | e -{DEEP}-> e' → | ||
156 | EAttr (<[x:=AttrN e]> αs) -{DEEP}-> EAttr (<[x:=AttrN e']> αs). | ||
157 | Proof. intros ???. apply (SCtx (λ e, EAttr (<[x:=AttrN e]> _))). by constructor. Qed. | ||
158 | Lemma SLetAttr μ k e1 e1' e2 : | ||
159 | e1 -{SHALLOW}-> e1' → ELetAttr k e1 e2 -{μ}-> ELetAttr k e1' e2. | ||
160 | Proof. apply (SCtx (λ e, ELetAttr _ e _)). constructor. Qed. | ||
161 | Lemma SBinOpL μ op e1 e1' e2 : | ||
162 | e1 -{SHALLOW}-> e1' → EBinOp op e1 e2 -{μ}-> EBinOp op e1' e2. | ||
163 | Proof. apply (SCtx (λ e, EBinOp _ e _)). constructor. Qed. | ||
164 | Lemma SBinOpR μ op e1 Φ e2 e2' : | ||
165 | final SHALLOW e1 → sem_bin_op op e1 Φ → | ||
166 | e2 -{SHALLOW}-> e2' → EBinOp op e1 e2 -{μ}-> EBinOp op e1 e2'. | ||
167 | Proof. intros ??. apply SCtx. by econstructor. Qed. | ||
168 | Lemma SIf μ e1 e1' e2 e3 : | ||
169 | e1 -{SHALLOW}-> e1' → EIf e1 e2 e3 -{μ}-> EIf e1' e2 e3. | ||
170 | Proof. apply (SCtx (λ e, EIf e _ _)). constructor. Qed. | ||
171 | |||
172 | Global Hint Constructors step : step. | ||
173 | Global Hint Resolve SAppL SAppR SSeq SList SAttr SLetAttr SBinOpL SBinOpR SIf : step. | ||
174 | |||
175 | Lemma step_not_final μ e1 e2 : e1 -{μ}-> e2 → ¬final μ e1. | ||
176 | Proof. | ||
177 | assert (∀ (αs : gmap string attr) x μ e, | ||
178 | map_Forall (λ _, final DEEP ∘ attr_expr) (<[x:=Attr μ e]> αs) → final DEEP e). | ||
179 | { intros αs x μ' e Hall. eapply (Hall _ (Attr _ _)), lookup_insert. } | ||
180 | induction 1; inv 1; inv_step; decompose_Forall; naive_solver. | ||
181 | Qed. | ||
182 | Lemma final_nf μ e : final μ e → nf (step μ) e. | ||
183 | Proof. by intros ? [??%step_not_final]. Qed. | ||
184 | |||
185 | Lemma step_any_shallow μ e1 e2 : | ||
186 | e1 -{μ}-> e2 → e1 -{SHALLOW}-> e2 ∨ final SHALLOW e1. | ||
187 | Proof. | ||
188 | induction 1; inv_step; | ||
189 | naive_solver eauto using final, no_recs_insert with step. | ||
190 | Qed. | ||
191 | |||
192 | Lemma step_shallow_any μ e1 e2 : e1 -{SHALLOW}-> e2 → e1 -{μ}-> e2. | ||
193 | Proof. | ||
194 | remember SHALLOW as μ'. induction 1; inv_step; simplify_eq/=; eauto with step. | ||
195 | Qed. | ||
196 | Lemma steps_shallow_any μ e1 e2 : e1 -{SHALLOW}->* e2 → e1 -{μ}->* e2. | ||
197 | Proof. induction 1; eauto using rtc, step_shallow_any. Qed. | ||
198 | Lemma final_any_shallow μ e : final μ e → final SHALLOW e. | ||
199 | Proof. destruct μ; [done|]. induction 1; simplify_eq/=; eauto using final. Qed. | ||
200 | Lemma stuck_shallow_any μ e : stuck SHALLOW e → stuck μ e. | ||
201 | Proof. | ||
202 | intros [Hnf Hfinal]. split; [|naive_solver eauto using final_any_shallow]. | ||
203 | intros [e' Hstep%step_any_shallow]; naive_solver. | ||
204 | Qed. | ||
205 | |||
206 | Lemma step_final_shallow μ e1 e2 : | ||
207 | final SHALLOW e1 → e1 -{μ}-> e2 → final SHALLOW e2. | ||
208 | Proof. | ||
209 | induction 1; intros; inv_step; decompose_Forall; | ||
210 | eauto using step, final, no_recs_insert; try done. | ||
211 | - by odestruct step_not_final. | ||
212 | - apply map_Forall_insert in H0 as [??]; simpl in *; last done. | ||
213 | by odestruct step_not_final. | ||
214 | Qed. | ||
215 | |||
216 | Lemma SAppL_rtc μ e1 e1' e2 : | ||
217 | e1 -{SHALLOW}->* e1' → EApp e1 e2 -{μ}->* EApp e1' e2. | ||
218 | Proof. induction 1; econstructor; eauto with step. Qed. | ||
219 | Lemma SAppR_rtc μ ms strict e1 e2 e2' : | ||
220 | e2 -{SHALLOW}->* e2' → | ||
221 | EApp (EAbsMatch ms strict e1) e2 -{μ}->* EApp (EAbsMatch ms strict e1) e2'. | ||
222 | Proof. induction 1; econstructor; eauto with step. Qed. | ||
223 | Lemma SSeq_rtc μ μ' e1 e1' e2 : | ||
224 | e1 -{μ'}->* e1' → ESeq μ' e1 e2 -{μ}->* ESeq μ' e1' e2. | ||
225 | Proof. induction 1; econstructor; eauto with step. Qed. | ||
226 | Lemma SList_rtc es1 e e' es2 : | ||
227 | Forall (final DEEP) es1 → | ||
228 | e -{DEEP}->* e' → | ||
229 | EList (es1 ++ e :: es2) -{DEEP}->* EList (es1 ++ e' :: es2). | ||
230 | Proof. induction 2; econstructor; eauto with step. Qed. | ||
231 | Lemma SLetAttr_rtc μ k e1 e1' e2 : | ||
232 | e1 -{SHALLOW}->* e1' → ELetAttr k e1 e2 -{μ}->* ELetAttr k e1' e2. | ||
233 | Proof. induction 1; econstructor; eauto with step. Qed. | ||
234 | Lemma SBinOpL_rtc μ op e1 e1' e2 : | ||
235 | e1 -{SHALLOW}->* e1' → EBinOp op e1 e2 -{μ}->* EBinOp op e1' e2. | ||
236 | Proof. induction 1; econstructor; eauto with step. Qed. | ||
237 | Lemma SBinOpR_rtc μ op e1 Φ e2 e2' : | ||
238 | final SHALLOW e1 → sem_bin_op op e1 Φ → | ||
239 | e2 -{SHALLOW}->* e2' → EBinOp op e1 e2 -{μ}->* EBinOp op e1 e2'. | ||
240 | Proof. induction 3; econstructor; eauto with step. Qed. | ||
241 | Lemma SIf_rtc μ e1 e1' e2 e3 : | ||
242 | e1 -{SHALLOW}->* e1' → EIf e1 e2 e3 -{μ}->* EIf e1' e2 e3. | ||
243 | Proof. induction 1; econstructor; eauto with step. Qed. | ||
244 | |||
245 | Lemma SApp_tc μ e1 e1' e2 : | ||
246 | e1 -{SHALLOW}->+ e1' → EApp e1 e2 -{μ}->+ EApp e1' e2. | ||
247 | Proof. induction 1; by econstructor; eauto with step. Qed. | ||
248 | Lemma SSeq_tc μ μ' e1 e1' e2 : | ||
249 | e1 -{μ'}->+ e1' → ESeq μ' e1 e2 -{μ}->+ ESeq μ' e1' e2. | ||
250 | Proof. induction 1; by econstructor; eauto with step. Qed. | ||
251 | Lemma SList_tc es1 e e' es2 : | ||
252 | Forall (final DEEP) es1 → | ||
253 | e -{DEEP}->+ e' → | ||
254 | EList (es1 ++ e :: es2) -{DEEP}->+ EList (es1 ++ e' :: es2). | ||
255 | Proof. induction 2; by econstructor; eauto with step. Qed. | ||
256 | Lemma SLetAttr_tc μ k e1 e1' e2 : | ||
257 | e1 -{SHALLOW}->+ e1' → ELetAttr k e1 e2 -{μ}->+ ELetAttr k e1' e2. | ||
258 | Proof. induction 1; by econstructor; eauto with step. Qed. | ||
259 | Lemma SBinOpL_tc μ op e1 e1' e2 : | ||
260 | e1 -{SHALLOW}->+ e1' → EBinOp op e1 e2 -{μ}->+ EBinOp op e1' e2. | ||
261 | Proof. induction 1; by econstructor; eauto with step. Qed. | ||
262 | Lemma SBinOpR_tc μ op e1 Φ e2 e2' : | ||
263 | final SHALLOW e1 → sem_bin_op op e1 Φ → | ||
264 | e2 -{SHALLOW}->+ e2' → EBinOp op e1 e2 -{μ}->+ EBinOp op e1 e2'. | ||
265 | Proof. induction 3; by econstructor; eauto with step. Qed. | ||
266 | Lemma SIf_tc μ e1 e1' e2 e3 : | ||
267 | e1 -{SHALLOW}->+ e1' → EIf e1 e2 e3 -{μ}->+ EIf e1' e2 e3. | ||
268 | Proof. induction 1; by econstructor; eauto with step. Qed. | ||
269 | |||
270 | Lemma SList_inv es1 e2 : | ||
271 | EList es1 -{DEEP}-> e2 ↔ ∃ ds1 ds2 e e', | ||
272 | es1 = ds1 ++ e :: ds2 ∧ e2 = EList (ds1 ++ e' :: ds2) ∧ | ||
273 | Forall (final DEEP) ds1 ∧ | ||
274 | e -{DEEP}-> e'. | ||
275 | Proof. split; intros; inv_step; naive_solver eauto using SList. Qed. | ||
276 | |||
277 | Lemma List_nf_cons_final es e : | ||
278 | final DEEP e → | ||
279 | nf (step DEEP) (EList es) → | ||
280 | nf (step DEEP) (EList (e :: es)). | ||
281 | Proof. | ||
282 | intros Hfinal Hnf [e' (ds1 & ds2 & e1 & e2 & ? & -> & Hds1 & Hstep)%SList_inv]. | ||
283 | destruct Hds1; simplify_eq/=. | ||
284 | - by apply step_not_final in Hstep. | ||
285 | - naive_solver eauto with step. | ||
286 | Qed. | ||
287 | Lemma List_nf_cons es e : | ||
288 | ¬final DEEP e → | ||
289 | nf (step DEEP) e → | ||
290 | nf (step DEEP) (EList (e :: es)). | ||
291 | Proof. | ||
292 | intros Hfinal Hnf [e' (ds1 & ds2 & e1 & e2 & ? & -> & Hds1 & Hstep)%SList_inv]. | ||
293 | destruct Hds1; naive_solver. | ||
294 | Qed. | ||
295 | |||
296 | Lemma List_steps_cons es1 es2 e : | ||
297 | final DEEP e → | ||
298 | EList es1 -{DEEP}->* EList es2 → | ||
299 | EList (e :: es1) -{DEEP}->* EList (e :: es2). | ||
300 | Proof. | ||
301 | intros ? Hstep. | ||
302 | remember (EList es1) as e1 eqn:He1; remember (EList es2) as e2 eqn:He2. | ||
303 | revert es1 es2 He1 He2. | ||
304 | induction Hstep as [|e1 e2 e3 Hstep Hstep' IH]; | ||
305 | intros es1 es3 ??; simplify_eq/=; [done|]. | ||
306 | inv_step. eapply rtc_l; [apply (SList (_ :: _))|]; naive_solver. | ||
307 | Qed. | ||
308 | |||
309 | Lemma SAttr_rec_rtc μ αs : | ||
310 | EAttr αs -{μ}->* | ||
311 | EAttr (AttrN ∘ from_attr (subst (indirects αs)) id <$> αs). | ||
312 | Proof. | ||
313 | destruct (decide (no_recs αs)) as [Hαs|]; [|by eauto using rtc_once, step]. | ||
314 | eapply reflexive_eq. f_equal. apply map_eq=> x. rewrite lookup_fmap. | ||
315 | destruct (αs !! x) as [[τ e]|] eqn:?; [|done]. | ||
316 | assert (τ = NONREC) as -> by eauto using no_recs_lookup. done. | ||
317 | Qed. | ||
318 | |||
319 | Lemma SAttr_lookup_rtc αs x e e' : | ||
320 | no_recs αs → | ||
321 | αs !! x = None → | ||
322 | (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) → | ||
323 | e -{DEEP}->* e' → | ||
324 | EAttr (<[x:=AttrN e]> αs) -{DEEP}->* EAttr (<[x:=AttrN e']> αs). | ||
325 | Proof. | ||
326 | intros Hrecs Hx Hfirst He. revert αs Hrecs Hx Hfirst. | ||
327 | induction He as [e|e1 e2 e3 He12 He23 IH]; intros eτs Hrec Hx Hfirst; [done|]. | ||
328 | eapply rtc_l; first by eapply SAttr. apply IH; [done..|]. | ||
329 | apply step_not_final in He12. naive_solver. | ||
330 | Qed. | ||
331 | |||
332 | Lemma SAttr_inv αs1 e2 : | ||
333 | no_recs αs1 → | ||
334 | EAttr αs1 -{DEEP}-> e2 ↔ ∃ αs x e e', | ||
335 | αs1 = <[x:=AttrN e]> αs ∧ e2 = EAttr (<[x:=AttrN e']> αs) ∧ | ||
336 | αs !! x = None ∧ | ||
337 | (∀ y α, αs !! y = Some α → final DEEP (attr_expr α) ∨ attr_le x y) ∧ | ||
338 | e -{DEEP}-> e'. | ||
339 | Proof. | ||
340 | split; [intros; inv_step|]; | ||
341 | naive_solver eauto using SAttr, no_recs_insert_inv. | ||
342 | Qed. | ||
343 | |||
344 | Lemma Attr_nf_insert_final αs x e : | ||
345 | no_recs αs → | ||
346 | αs !! x = None → | ||
347 | final DEEP e → | ||
348 | (∀ y, is_Some (αs !! y) → attr_le x y) → | ||
349 | nf (step DEEP) (EAttr αs) → | ||
350 | nf (step DEEP) (EAttr (<[x:=AttrN e]> αs)). | ||
351 | Proof. | ||
352 | intros Hrecs Hx Hfinal Hleast Hnf | ||
353 | [? (αs'&x'&e'&e''&Hαs&->&Hx'&?&Hstep)%SAttr_inv]; | ||
354 | last by eauto using no_recs_insert. | ||
355 | assert (x ≠ x'). | ||
356 | { intros ->. apply (f_equal (.!! x')) in Hαs. rewrite !lookup_insert in Hαs. | ||
357 | apply step_not_final in Hstep. naive_solver. } | ||
358 | destruct Hnf. exists (EAttr (<[x':=AttrN e'']> (delete x αs'))). | ||
359 | rewrite -(delete_insert αs x (AttrN e)) // Hαs delete_insert_ne //. | ||
360 | refine (SCtx _ _ _ _ _ (CAttr _ _ _ _ _) _); | ||
361 | [|by rewrite lookup_delete_ne| |done]. | ||
362 | - apply (no_recs_insert _ x e) in Hrecs. rewrite Hαs in Hrecs. | ||
363 | apply no_recs_insert_inv in Hrecs; last done. by apply map_Forall_delete. | ||
364 | - intros ?? ?%lookup_delete_Some; naive_solver. | ||
365 | Qed. | ||
366 | Lemma Attr_nf_insert αs x e : | ||
367 | no_recs αs → | ||
368 | αs !! x = None → | ||
369 | ¬final DEEP e → | ||
370 | (∀ y, is_Some (αs !! y) → attr_le x y) → | ||
371 | nf (step DEEP) e → | ||
372 | nf (step DEEP) (EAttr (<[x:=AttrN e]> αs)). | ||
373 | Proof. | ||
374 | intros Hrecs Hx ?? Hnf [? (αs'&x'&e'&e''&Hαs&->&Hx'&Hleast'&Hstep)%SAttr_inv]; | ||
375 | last eauto using no_recs_insert. | ||
376 | assert (x ≠ x') as Hxx'. | ||
377 | { intros ->. apply (f_equal (.!! x')) in Hαs. rewrite !lookup_insert in Hαs. | ||
378 | naive_solver. } | ||
379 | odestruct (Hleast' x (AttrN e)); [|done|]. | ||
380 | - apply (f_equal (.!! x)) in Hαs. | ||
381 | by rewrite lookup_insert lookup_insert_ne in Hαs. | ||
382 | - apply (f_equal (.!! x')) in Hαs. | ||
383 | rewrite lookup_insert lookup_insert_ne // in Hαs. | ||
384 | destruct Hxx'. apply (anti_symm attr_le); naive_solver. | ||
385 | Qed. | ||
386 | |||
387 | Lemma Attr_step_dom μ αs1 e2 : | ||
388 | EAttr αs1 -{μ}-> e2 → | ||
389 | ∃ αs2, e2 = EAttr αs2 ∧ ∀ i, αs1 !! i = None ↔ αs2 !! i = None. | ||
390 | Proof. | ||
391 | intros; inv_step; (eexists; split; [done|]). | ||
392 | - intros i. by rewrite lookup_fmap fmap_None. | ||
393 | - intros i. rewrite !lookup_insert_None; naive_solver. | ||
394 | Qed. | ||
395 | Lemma Attr_steps_dom μ αs1 αs2 : | ||
396 | EAttr αs1 -{μ}->* EAttr αs2 → ∀ i, αs1 !! i = None ↔ αs2 !! i = None. | ||
397 | Proof. | ||
398 | intros Hstep. | ||
399 | remember (EAttr αs1) as e1 eqn:He1; remember (EAttr αs2) as e2 eqn:He2. | ||
400 | revert αs1 αs2 He1 He2. induction Hstep as [|e1 e2 e3 Hstep Hstep' IH]; | ||
401 | intros αs1 αs3 ??; simplify_eq/=; [done|]. | ||
402 | apply Attr_step_dom in Hstep; naive_solver. | ||
403 | Qed. | ||
404 | |||
405 | Lemma Attr_step_recs αs1 αs2 : | ||
406 | EAttr αs1 -{DEEP}-> EAttr αs2 → no_recs αs1 → no_recs αs2. | ||
407 | Proof. intros. inv_step; by eauto using no_recs_insert. Qed. | ||
408 | Lemma Attr_steps_recs αs1 αs2 : | ||
409 | EAttr αs1 -{DEEP}->* EAttr αs2 → no_recs αs1 → no_recs αs2. | ||
410 | Proof. | ||
411 | intros Hstep. | ||
412 | remember (EAttr αs1) as e1 eqn:He1; remember (EAttr αs2) as e2 eqn:He2. | ||
413 | revert αs1 αs2 He1 He2. induction Hstep as [|e1 e2 e3 Hstep Hstep' IH]; | ||
414 | intros αs1 αs3 ???; simplify_eq/=; [done|]. | ||
415 | pose proof (Attr_step_dom _ _ _ Hstep) as (es2 & -> & ?). | ||
416 | apply Attr_step_recs in Hstep; naive_solver. | ||
417 | Qed. | ||
418 | |||
419 | Lemma Attr_step_insert αs1 αs2 x e : | ||
420 | no_recs αs1 → | ||
421 | αs1 !! x = None → | ||
422 | final DEEP e → | ||
423 | EAttr αs1 -{DEEP}-> EAttr αs2 → | ||
424 | EAttr (<[x:=AttrN e]> αs1) -{DEEP}-> EAttr (<[x:=AttrN e]> αs2). | ||
425 | Proof. | ||
426 | intros Hrecs Hx ? | ||
427 | (αs' & x' & e1 & e1' & ? & ? & ? & ? & ?)%SAttr_inv; [|done]; simplify_eq. | ||
428 | apply lookup_insert_None in Hx as [??]. rewrite !(insert_commute _ x) //. | ||
429 | eapply SAttr; [|by rewrite lookup_insert_ne| |done]. | ||
430 | - by eapply no_recs_insert, no_recs_insert_inv. | ||
431 | - intros y e' ?%lookup_insert_Some; naive_solver. | ||
432 | Qed. | ||
433 | Lemma Attr_steps_insert αs1 αs2 x e : | ||
434 | no_recs αs1 → | ||
435 | αs1 !! x = None → | ||
436 | final DEEP e → | ||
437 | EAttr αs1 -{DEEP}->* EAttr αs2 → | ||
438 | EAttr (<[x:=AttrN e]> αs1) -{DEEP}->* EAttr (<[x:=AttrN e]> αs2). | ||
439 | Proof. | ||
440 | intros Hrecs Hx ? Hstep. | ||
441 | remember (EAttr αs1) as e1 eqn:He1; remember (EAttr αs2) as e2 eqn:He2. | ||
442 | revert αs1 αs2 Hx Hrecs He1 He2. | ||
443 | induction Hstep as [|e1 e2 e3 Hstep Hstep' IH]; | ||
444 | intros αs1 αs3 ????; simplify_eq/=; [done|]. | ||
445 | pose proof (Attr_step_dom _ _ _ Hstep) as (αs2 & -> & Hdom). | ||
446 | eapply rtc_l; first by eapply Attr_step_insert. | ||
447 | eapply IH; naive_solver eauto using Attr_step_recs. | ||
448 | Qed. | ||
449 | |||
450 | Reserved Infix "=D=>" (right associativity, at level 55). | ||
451 | |||
452 | Inductive step_delayed : relation expr := | ||
453 | | RDrefl e : | ||
454 | e =D=> e | ||
455 | | RDId x e1 e2 : | ||
456 | e1 =D=> e2 → | ||
457 | EId x (Some (ABS, e1)) =D=> e2 | ||
458 | | RDBinOp op e1 e1' e2 e2' : | ||
459 | e1 =D=> e1' → e2 =D=> e2' → EBinOp op e1 e2 =D=> EBinOp op e1' e2' | ||
460 | | RDIf e1 e1' e2 e2' e3 e3' : | ||
461 | e1 =D=> e1' → e2 =D=> e2' → e3 =D=> e3' → EIf e1 e2 e3 =D=> EIf e1' e2' e3' | ||
462 | where "e1 =D=> e2" := (step_delayed e1 e2). | ||
463 | |||
464 | Global Instance step_delayed_po : PreOrder step_delayed. | ||
465 | Proof. | ||
466 | split; [constructor|]. | ||
467 | intros e1 e2 e3 Hstep. revert e3. | ||
468 | induction Hstep; inv 1; eauto using step_delayed. | ||
469 | Qed. | ||
470 | Hint Extern 0 (_ =D=> _) => reflexivity : core. | ||
471 | |||
472 | Lemma delayed_final_l e1 e2 : | ||
473 | final SHALLOW e1 → | ||
474 | e1 =D=> e2 → | ||
475 | e1 = e2. | ||
476 | Proof. intros Hfinal. induction 1; try by inv Hfinal. Qed. | ||
477 | |||
478 | Lemma delayed_final_r μ e1 e2 : | ||
479 | final μ e2 → | ||
480 | e1 =D=> e2 → | ||
481 | e1 -{μ}->* e2. | ||
482 | Proof. | ||
483 | intros Hfinal. induction 1; try by inv Hfinal. | ||
484 | eapply rtc_l; [constructor|]. eauto. | ||
485 | Qed. | ||
486 | |||
487 | Lemma delayed_step_l μ e1 e1' e2 : | ||
488 | e1 =D=> e1' → | ||
489 | e1 -{μ}-> e2 → | ||
490 | ∃ e2', e1' -{μ}->* e2' ∧ e2 =D=> e2'. | ||
491 | Proof. | ||
492 | intros Hrem. revert μ e2. | ||
493 | induction Hrem; intros μ ? Hstep. | ||
494 | - eauto using rtc_once. | ||
495 | - inv_step. by exists e2. | ||
496 | - inv_step. | ||
497 | + eapply delayed_final_l in Hrem1 as ->, Hrem2 as ->; [|by eauto..]. | ||
498 | eexists; split; [|done]. eapply rtc_once. by econstructor. | ||
499 | + apply IHHrem1 in H2 as (e1'' & ? & ?). | ||
500 | eexists; split; [by eapply SBinOpL_rtc|]. by constructor. | ||
501 | + eapply delayed_final_l in Hrem1 as ->; [|by eauto..]. | ||
502 | apply IHHrem2 in H2 as (e2'' & ? & ?). | ||
503 | eexists (EBinOp _ e1' e2''); split; [|by constructor]. | ||
504 | by eapply SBinOpR_rtc. | ||
505 | - inv_step. | ||
506 | + eapply delayed_final_l in Hrem1 as <-; [|by repeat constructor]. | ||
507 | eexists; split; [eapply rtc_once; constructor|]. by destruct b. | ||
508 | + apply IHHrem1 in H2 as (e1'' & ? & ?). | ||
509 | eexists; split; [by eapply SIf_rtc|]. by constructor. | ||
510 | Qed. | ||
511 | |||
512 | Lemma delayed_steps_l μ e1 e1' e2 : | ||
513 | e1 =D=> e1' → | ||
514 | e1 -{μ}->* e2 → | ||
515 | ∃ e2', e1' -{μ}->* e2' ∧ e2 =D=> e2'. | ||
516 | Proof. | ||
517 | intros Hdel Hsteps. revert e1' Hdel. | ||
518 | induction Hsteps as [e|e1 e2 e3 Hstep Hsteps IH]; intros e1' Hdel. | ||
519 | { eexists; by split. } | ||
520 | eapply delayed_step_l in Hstep as (e2' & Hstep2 & Hdel2); [|done]. | ||
521 | apply IH in Hdel2 as (e3' & ? & ?). eexists; by split; [etrans|]. | ||
522 | Qed. | ||
523 | |||
524 | Lemma delayed_step_r μ e1 e1' e2 : | ||
525 | e1' =D=> e1 → | ||
526 | e1 -{μ}-> e2 → | ||
527 | ∃ e2', e1' -{μ}->+ e2' ∧ e2' =D=> e2. | ||
528 | Proof. | ||
529 | intros Hrem. revert μ e2. | ||
530 | induction Hrem; intros μ ? Hstep. | ||
531 | - eauto using tc_once. | ||
532 | - apply IHHrem in Hstep as (e1' & ? & ?). | ||
533 | eexists. split; [|done]. eapply tc_l; [econstructor|done]. | ||
534 | - inv_step. | ||
535 | + exists e0; split; [|done]. | ||
536 | eapply tc_rtc_l; [by eapply SBinOpL_rtc, delayed_final_r, Hrem1|]. | ||
537 | eapply tc_rtc_l; [by eapply SBinOpR_rtc, delayed_final_r, Hrem2|]. | ||
538 | eapply tc_once. by econstructor. | ||
539 | + apply IHHrem1 in H2 as (e1'' & ? & ?). | ||
540 | eexists; split; [by eapply SBinOpL_tc|]. by constructor. | ||
541 | + apply IHHrem2 in H2 as (e2'' & ? & ?). | ||
542 | eexists (EBinOp _ e1' e2''); split; [|by apply RDBinOp]. | ||
543 | eapply tc_rtc_l; [by eapply SBinOpL_rtc, delayed_final_r, Hrem1|]. | ||
544 | by eapply SBinOpR_tc. | ||
545 | - inv_step. | ||
546 | + exists (if b then e2 else e3). split; [|by destruct b]. | ||
547 | eapply tc_rtc_l; | ||
548 | [eapply SIf_rtc, delayed_final_r, Hrem1; by repeat constructor|]. | ||
549 | eapply tc_once; constructor. | ||
550 | + apply IHHrem1 in H2 as (e1'' & ? & ?). | ||
551 | eexists; split; [by eapply SIf_tc|]. by constructor. | ||
552 | Qed. | ||
553 | |||
554 | Lemma delayed_steps_r μ e1 e1' e2 : | ||
555 | e1' =D=> e1 → | ||
556 | e1 -{μ}->* e2 → | ||
557 | ∃ e2', e1' -{μ}->* e2' ∧ e2' =D=> e2. | ||
558 | Proof. | ||
559 | intros Hdel Hsteps. revert e1' Hdel. | ||
560 | induction Hsteps as [e|e1 e2 e3 Hstep Hsteps IH]; intros e1' Hdel. | ||
561 | { eexists; by split. } | ||
562 | eapply delayed_step_r in Hstep as (e2' & Hstep2%tc_rtc & Hdel2); [|done]. | ||
563 | apply IH in Hdel2 as (e3' & ? & ?). eexists; by split; [etrans|]. | ||
564 | Qed. | ||
565 | |||
566 | (** Determinism *) | ||
567 | |||
568 | Lemma bin_op_det op e Φ Ψ : | ||
569 | sem_bin_op op e Φ → | ||
570 | sem_bin_op op e Ψ → | ||
571 | Φ = Ψ. | ||
572 | Proof. by destruct 1; inv 1. Qed. | ||
573 | |||
574 | Lemma bin_op_rel_det op e1 Φ e2 d1 d2 : | ||
575 | sem_bin_op op e1 Φ → | ||
576 | Φ e2 d1 → | ||
577 | Φ e2 d2 → | ||
578 | d1 = d2. | ||
579 | Proof. | ||
580 | assert (AntiSymm eq attr_le) by apply _. | ||
581 | unfold AntiSymm in *. inv 1; repeat case_match; naive_solver. | ||
582 | Qed. | ||
583 | |||
584 | Lemma matches_present x e md es ms strict βs : | ||
585 | es !! x = Some e → ms !! x = Some md → | ||
586 | matches es ms strict βs → | ||
587 | βs !! x = Some (AttrN e). | ||
588 | Proof. | ||
589 | intros Hes Hms. induction 1; try done. | ||
590 | - by apply lookup_insert_Some in Hes as [[]|[]]; simplify_map_eq. | ||
591 | - by simplify_map_eq. | ||
592 | Qed. | ||
593 | |||
594 | Lemma matches_default x es ms d strict βs : | ||
595 | es !! x = None → | ||
596 | ms !! x = Some (Some d) → | ||
597 | matches es ms strict βs → | ||
598 | βs !! x = Some (AttrR d). | ||
599 | Proof. | ||
600 | intros Hes Hms. induction 1; try done. | ||
601 | - by apply lookup_insert_None in Hes as []; simplify_map_eq. | ||
602 | - by apply lookup_insert_Some in Hms as [[]|[]]; simplify_map_eq. | ||
603 | Qed. | ||
604 | |||
605 | Lemma matches_weaken x es ms strict βs : | ||
606 | matches es ms strict βs → | ||
607 | matches (delete x es) (delete x ms) strict (delete x βs). | ||
608 | Proof. | ||
609 | induction 1; [constructor|constructor|..]; rename x0 into y; | ||
610 | (destruct (decide (x = y)) as [->|Hxy]; | ||
611 | [ rewrite !delete_insert_delete // | ||
612 | | rewrite !delete_insert_ne //; constructor; | ||
613 | by simplify_map_eq ]). | ||
614 | Qed. | ||
615 | |||
616 | Lemma matches_det es ms strict βs1 βs2 : | ||
617 | matches es ms strict βs1 → | ||
618 | matches es ms strict βs2 → | ||
619 | βs1 = βs2. | ||
620 | Proof. | ||
621 | intros Hβs1. revert βs2. induction Hβs1; intros βs2 Hβs2; | ||
622 | try (inv Hβs2; done || (by exfalso; eapply (insert_non_empty (M:=stringmap)))). | ||
623 | - eapply (matches_weaken x) in Hβs2 as Hβs2'. | ||
624 | rewrite !delete_insert // in Hβs2'. | ||
625 | rewrite (IHHβs1 _ Hβs2') insert_delete //. | ||
626 | eapply matches_present; eauto; apply lookup_insert. | ||
627 | - eapply (matches_weaken x) in Hβs2 as Hβs2'. | ||
628 | rewrite delete_notin // delete_insert // in Hβs2'. | ||
629 | rewrite (IHHβs1 _ Hβs2') insert_delete //. | ||
630 | eapply matches_default; eauto. apply lookup_insert. | ||
631 | Qed. | ||
632 | |||
633 | Lemma ctx_det K1 K2 e1 e2 μ μ1' μ2' : | ||
634 | K1 e1 = K2 e2 → | ||
635 | ctx1 μ1' μ K1 → | ||
636 | ctx1 μ2' μ K2 → | ||
637 | red (step μ1') e1 → | ||
638 | red (step μ2') e2 → | ||
639 | K1 = K2 ∧ e1 = e2 ∧ μ1' = μ2'. | ||
640 | Proof. | ||
641 | intros Hes HK1 HK2 Hred1 Hred2. | ||
642 | induction HK1; inv HK2; try done. | ||
643 | - apply not_elem_of_app_cons_inv_l in Hes as [<- [<- <-]]; first done. | ||
644 | + intros He1. apply (proj1 (Forall_forall _ _) H0) in He1. | ||
645 | inv Hred1. by apply step_not_final in H1. | ||
646 | + intros He2. apply (proj1 (Forall_forall _ _) H) in He2. | ||
647 | inv Hred2. by apply step_not_final in H1. | ||
648 | - destruct (decide (x = x0)) as [<-|]. | ||
649 | { by apply map_insert_inv_eq in Hes as [[= ->] [= ->]]. } | ||
650 | apply map_insert_inv_ne in Hes as (Hx0 & Hx & Hαs); try done. | ||
651 | apply H1 in Hx0 as [contra | Hxlex0]. | ||
652 | + inv Hred2. by apply step_not_final in H5. | ||
653 | + apply H4 in Hx as [contra | Hx0lex]. | ||
654 | * inv Hred1. by apply step_not_final in H5. | ||
655 | * assert (Hasym : AntiSymm eq attr_le) by apply _. | ||
656 | by pose proof (Hasym _ _ Hxlex0 Hx0lex). | ||
657 | - inv Hred1. inv_step. | ||
658 | - inv Hred2. inv_step. | ||
659 | - inv Hred1. by apply step_not_final in H1. | ||
660 | - inv Hred2. by apply step_not_final in H1. | ||
661 | Qed. | ||
662 | |||
663 | Lemma step_det μ e d1 d2 : | ||
664 | e -{μ}-> d1 → | ||
665 | e -{μ}-> d2 → | ||
666 | d1 = d2. | ||
667 | Proof. | ||
668 | intros Hred1. revert d2. | ||
669 | induction Hred1; intros d2 Hred2; inv Hred2; try by inv_step. | ||
670 | - by apply (matches_det _ _ _ _ _ H0) in H8 as <-. | ||
671 | - inv_step. by apply step_not_final in H3. | ||
672 | - inv_step. destruct H. by apply no_recs_insert. | ||
673 | - assert (Φ = Φ0) as <- by (by eapply bin_op_det). | ||
674 | by eapply bin_op_rel_det. | ||
675 | - inv_step; by apply step_not_final in H6. | ||
676 | - inv_step. by apply step_not_final in Hred1. | ||
677 | - inv_step. destruct H2. by apply no_recs_insert. | ||
678 | - inv_step; by apply step_not_final in Hred1. | ||
679 | - eapply ctx_det in H0 as (?&?&?); [|by eauto..]; naive_solver. | ||
680 | Qed. | ||
diff --git a/theories/nix/tests.v b/theories/nix/tests.v new file mode 100644 index 0000000..cbce874 --- /dev/null +++ b/theories/nix/tests.v | |||
@@ -0,0 +1,185 @@ | |||
1 | From mininix Require Export nix.interp nix.notations. | ||
2 | From stdpp Require Import options. | ||
3 | Open Scope Z_scope. | ||
4 | |||
5 | (** Compare base vals without comparing the proofs. Since we do not have | ||
6 | definitional proof irrelevance, comparing the proofs would fail (and in practice | ||
7 | make Coq loop). *) | ||
8 | Definition res_eq (rv : res val) (bl2 : base_lit) := | ||
9 | match rv with | ||
10 | | Res (Some (VLit bl1 _)) => bl1 = bl2 | ||
11 | | _ => False | ||
12 | end. | ||
13 | Infix "=?" := res_eq. | ||
14 | |||
15 | Definition float_1 := | ||
16 | ceil: (Float.of_Z 20 /: 3). | ||
17 | Goal interp 100 ∅ float_1 =? 7. | ||
18 | Proof. by vm_compute. Qed. | ||
19 | |||
20 | Definition float_2 := | ||
21 | Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *: | ||
22 | Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *: | ||
23 | Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *: | ||
24 | Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000 *: | ||
25 | Float.of_Z 100000000000000000000000000000000000000000000000000000000000000000000000000000. | ||
26 | Goal interp 100 ∅ float_2 =? NFloat (Binary.B754_infinity false). | ||
27 | Proof. by vm_compute. Qed. | ||
28 | |||
29 | Definition float_3 := float_2 /: float_2. | ||
30 | Goal interp 100 ∅ float_3 =? NFloat (`Float.indef_nan). | ||
31 | Proof. by vm_compute. Qed. | ||
32 | |||
33 | Definition let_let := | ||
34 | let: "x" := 1 in let: "x" := 2 in "x". | ||
35 | Goal interp 100 ∅ let_let =? 2. | ||
36 | Proof. by vm_compute. Qed. | ||
37 | |||
38 | Definition with_let := | ||
39 | with: EAttr {[ "x" := AttrN 1 ]} in let: "x" := 2 in "x". | ||
40 | Goal interp 100 ∅ with_let =? 2. | ||
41 | Proof. by vm_compute. Qed. | ||
42 | |||
43 | Definition let_with := | ||
44 | let: "x" := 1 in with: EAttr {[ "x" := AttrN 2 ]} in "x". | ||
45 | Goal interp 100 ∅ let_with =? 1. | ||
46 | Proof. by vm_compute. Qed. | ||
47 | |||
48 | Definition with_with := | ||
49 | with: EAttr {[ "x" := AttrN 1 ]} in with: EAttr {[ "x" := AttrN 2 ]} in "x". | ||
50 | Goal interp 100 ∅ with_with =? 2. | ||
51 | Proof. by vm_compute. Qed. | ||
52 | |||
53 | Definition with_with_inherit := | ||
54 | with: EAttr {[ "x" := AttrN 1 ]} in with: EAttr {[ "x" := AttrN "x" ]} in "x". | ||
55 | Goal interp 100 ∅ with_with_inherit =? 1. | ||
56 | Proof. by vm_compute. Qed. | ||
57 | |||
58 | Definition with_loop := | ||
59 | with: EAttr {[ "x" := AttrR "x" ]} in "x". | ||
60 | Goal interp 100 ∅ with_loop = NoFuel. | ||
61 | Proof. by vm_compute. Qed. | ||
62 | |||
63 | Definition rec_attr_shadow_1 := | ||
64 | let: "foo" := EAttr {[ "bar" := AttrN 10 ]} in | ||
65 | EAttr {[ | ||
66 | "bar" := AttrR ("foo" .: "bar"); | ||
67 | "foo" := AttrR (EAttr {[ "bar" := AttrN 20 ]}) | ||
68 | ]} .: "bar". | ||
69 | Goal interp 100 ∅ rec_attr_shadow_1 =? 20. | ||
70 | Proof. by vm_compute. Qed. | ||
71 | |||
72 | Definition rec_attr_shadow_2 := | ||
73 | EAttr {[ | ||
74 | "y" := AttrR (EAttr {[ "y" := AttrN "z" ]} .: "y"); | ||
75 | "z" := AttrR 20 | ||
76 | ]} .: "y". | ||
77 | Goal interp 100 ∅ rec_attr_shadow_2 =? 20. | ||
78 | Proof. by vm_compute. Qed. | ||
79 | |||
80 | Definition nested_functor_1 := | ||
81 | EAttr {[ "__functor" := AttrN $ λ: "self", | ||
82 | EAttr {[ "__functor" := AttrN $ λ: "self" "x", 10 ]} ]} 10. | ||
83 | Goal interp 100 ∅ nested_functor_1 =? 10. | ||
84 | Proof. by vm_compute. Qed. | ||
85 | |||
86 | Definition nested_functor_2 := | ||
87 | EAttr {[ "__functor" := AttrN $ | ||
88 | EAttr {[ "__functor" := AttrN $ λ: "self" "self" "x", 10 ]} ]} 10. | ||
89 | Goal interp 100 ∅ nested_functor_2 =? 10. | ||
90 | Proof. by vm_compute. Qed. | ||
91 | |||
92 | Definition functor_loop_1 := | ||
93 | EAttr {[ "__functor" := AttrN $ | ||
94 | λ: "self", "self" "self" | ||
95 | ]} 10. | ||
96 | Goal interp 1000 ∅ functor_loop_1 = NoFuel. | ||
97 | Proof. by vm_compute. Qed. | ||
98 | |||
99 | Definition functor_loop_2 := | ||
100 | EAttr {[ "__functor" := AttrN $ | ||
101 | λ: "self" "f", "f" ("self" "f") | ||
102 | ]} (λ: "go" "x", "go" "x") 10. | ||
103 | Goal interp 1000 ∅ functor_loop_2 = NoFuel. | ||
104 | Proof. by vm_compute. Qed. | ||
105 | |||
106 | Fixpoint many_lets (i : nat) (e : expr) : expr := | ||
107 | match i with | ||
108 | | O => e | ||
109 | | S i => let: "x" +:+ pretty i := 0 in many_lets i e | ||
110 | end. | ||
111 | |||
112 | Fixpoint many_adds (i : nat) : expr := | ||
113 | match i with | ||
114 | | O => 0 | ||
115 | | S i => ("x" +:+ pretty i) +: many_adds i | ||
116 | end. | ||
117 | |||
118 | Definition big_prog (i : nat) : expr := many_lets i $ many_adds i. | ||
119 | |||
120 | Definition big := big_prog 1000. | ||
121 | |||
122 | Goal interp 5000 ∅ big =? 0. | ||
123 | Proof. by vm_compute. Qed. | ||
124 | |||
125 | Definition matching_1 := | ||
126 | (λattr: {[ "x" := None; "y" := None ]}, "x" +: "y") | ||
127 | (EAttr {[ "x" := AttrN 10; "y" := AttrN 11 ]}). | ||
128 | Goal interp 1000 ∅ matching_1 =? 21. | ||
129 | Proof. by vm_compute. Qed. | ||
130 | |||
131 | Definition matching_2 := | ||
132 | (λattr: {[ "x" := None; "y" := Some (EId' "x") ]}, "x" +: "y") | ||
133 | (EAttr {[ "x" := AttrN 10 ]}). | ||
134 | Goal interp 1000 ∅ matching_2 =? 20. | ||
135 | Proof. by vm_compute. Qed. | ||
136 | |||
137 | Definition matching_3 := | ||
138 | (λattr: {[ "x" := None; "y" := None ]}, "x" +: "y") | ||
139 | (EAttr {[ "x" := AttrN 10 ]}). | ||
140 | Goal interp 1000 ∅ matching_3 = mfail. | ||
141 | Proof. by vm_compute. Qed. | ||
142 | |||
143 | Definition matching_4 := | ||
144 | (λattr: {[ "x" := None; "y" := None ]}, "x" +: "y") | ||
145 | (EAttr {[ "x" := AttrN 10; "y" := AttrN 11; "z" := AttrN 12 ]}). | ||
146 | Goal interp 1000 ∅ matching_4 = mfail. | ||
147 | Proof. by vm_compute. Qed. | ||
148 | |||
149 | Definition matching_5 := | ||
150 | (λattr: {[ "x" := None; "y" := None ]} .., "x" +: "y") | ||
151 | (EAttr {[ "x" := AttrN 10; "y" := AttrN 11; "z" := AttrN 12 ]}). | ||
152 | Goal interp 1000 ∅ matching_5 =? 21. | ||
153 | Proof. by vm_compute. Qed. | ||
154 | |||
155 | Definition matching_6 := | ||
156 | (λattr: {[ "y" := Some (EId' "y") ]}, "y") | ||
157 | (EAttr {[ "y" := AttrN 10 ]}). | ||
158 | Goal interp 1000 ∅ matching_6 =? 10. | ||
159 | Proof. by vm_compute. Qed. | ||
160 | |||
161 | Definition matching_7 := | ||
162 | (λattr: {[ "y" := Some (EId' "y") ]}, "y") (EAttr ∅). | ||
163 | Goal interp 1000 ∅ matching_7 = NoFuel. | ||
164 | Proof. by vm_compute. Qed. | ||
165 | |||
166 | Definition matching_8 := | ||
167 | (λattr: {[ "y" := Some (EId' "y") ]}.., "y") | ||
168 | (EAttr {[ "x" := AttrN 10 ]}). | ||
169 | Goal interp 1000 ∅ matching_8 = NoFuel. | ||
170 | Proof. by vm_compute. Qed. | ||
171 | |||
172 | Definition list_lt_1 := | ||
173 | EList [ELit 2; ELit 3] <: EList [ELit 3]. | ||
174 | Goal interp 1000 ∅ list_lt_1 =? true. | ||
175 | Proof. by vm_compute. Qed. | ||
176 | |||
177 | Definition list_lt_2 := | ||
178 | EList [ELit 2; ELit 3] <: EList [ELit 2]. | ||
179 | Goal interp 1000 ∅ list_lt_2 =? false. | ||
180 | Proof. by vm_compute. Qed. | ||
181 | |||
182 | Definition list_lt_3 := | ||
183 | EList [ELit 2] <: EList [ELit 2; ELit 3]. | ||
184 | Goal interp 1000 ∅ list_lt_3 =? true. | ||
185 | Proof. by vm_compute. Qed. | ||
diff --git a/theories/nix/wp.v b/theories/nix/wp.v new file mode 100644 index 0000000..0eca6e1 --- /dev/null +++ b/theories/nix/wp.v | |||
@@ -0,0 +1,143 @@ | |||
1 | From mininix Require Export nix.operational_props. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Definition wp (μ : mode) (e : expr) (Φ : expr → Prop) : Prop := | ||
5 | ∃ e', e -{μ}->* e' ∧ final μ e' ∧ Φ e'. | ||
6 | |||
7 | Lemma Lit_wp μ Φ bl : | ||
8 | base_lit_ok bl → | ||
9 | Φ (ELit bl) → | ||
10 | wp μ (ELit bl) Φ. | ||
11 | Proof. exists (ELit bl). by repeat constructor. Qed. | ||
12 | |||
13 | Lemma Abs_wp μ Φ x e : | ||
14 | Φ (EAbs x e) → | ||
15 | wp μ (EAbs x e) Φ. | ||
16 | Proof. exists (EAbs x e). by repeat constructor. Qed. | ||
17 | |||
18 | Lemma AbsMatch_wp μ Φ ms strict e : | ||
19 | Φ (EAbsMatch ms strict e) → | ||
20 | wp μ (EAbsMatch ms strict e) Φ. | ||
21 | Proof. exists (EAbsMatch ms strict e). by repeat constructor. Qed. | ||
22 | |||
23 | Lemma LetAttr_no_recs_wp μ Φ k αs e : | ||
24 | no_recs αs → | ||
25 | wp μ (subst ((k,.) ∘ attr_expr <$> αs) e) Φ → | ||
26 | wp μ (ELetAttr k (EAttr αs) e) Φ. | ||
27 | Proof. | ||
28 | intros Hαs (e' & Hsteps & ? & HΦ). exists e'. split; [|done]. | ||
29 | etrans; [|apply Hsteps]. apply rtc_once. by constructor. | ||
30 | Qed. | ||
31 | |||
32 | Lemma BinOp_wp μ Φ op e1 e2 : | ||
33 | wp SHALLOW e1 (λ e1', ∃ Φop, | ||
34 | sem_bin_op op e1' Φop ∧ | ||
35 | wp SHALLOW e2 (λ e2', ∃ e', Φop e2' e' ∧ wp μ e' Φ)) → | ||
36 | wp μ (EBinOp op e1 e2) Φ. | ||
37 | Proof. | ||
38 | intros (e1' & Hsteps1 & ? & Φop & Hop1 & e2' & Hsteps2 & ? | ||
39 | & e' & Hop2 & e'' & Hsteps & ? & HΦ). | ||
40 | exists e''. split; [|done]. | ||
41 | etrans; [by apply SBinOpL_rtc|]. | ||
42 | etrans; [by eapply SBinOpR_rtc|]. | ||
43 | eapply rtc_l; [by econstructor|]. done. | ||
44 | Qed. | ||
45 | |||
46 | Lemma Id_wp μ Φ x k e : | ||
47 | wp μ e Φ → | ||
48 | wp μ (EId x (Some (k,e))) Φ. | ||
49 | Proof. | ||
50 | intros (e' & Hsteps & ? & HΦ). exists e'. split; [|done]. | ||
51 | etrans; [|apply Hsteps]. apply rtc_once. constructor. | ||
52 | Qed. | ||
53 | |||
54 | Lemma App_wp μ Φ e1 e2 : | ||
55 | wp SHALLOW e1 (λ e1', wp μ (EApp e1' e2) Φ) ↔ | ||
56 | wp μ (EApp e1 e2) Φ. | ||
57 | Proof. | ||
58 | split. | ||
59 | - intros (e1' & Hsteps1 & ? & e' & Hsteps2 & ? & HΦ). | ||
60 | exists e'; split; [|done]. etrans; [|apply Hsteps2]. | ||
61 | by apply SAppL_rtc. | ||
62 | - intros (e' & Hsteps & Hfinal & HΦ). | ||
63 | cut (∃ e1', e1 -{SHALLOW}->* e1' ∧ final SHALLOW e1' ∧ EApp e1' e2 -{μ}->* e'). | ||
64 | { intros (e1'&?&?&?). exists e1'. split_and!; [done..|]. by exists e'. } | ||
65 | clear Φ HΦ. apply rtc_nsteps in Hsteps as [n Hsteps]. | ||
66 | revert e1 Hsteps. induction n as [|n IH]; intros e1 Hsteps. | ||
67 | { inv Hsteps. inv Hfinal. } | ||
68 | inv Hsteps. inv H0. | ||
69 | + eexists; split_and!; [done|by constructor|]. | ||
70 | eapply rtc_l; [by constructor|by eapply rtc_nsteps_2]. | ||
71 | + eexists; split_and!; [done|by constructor|]. | ||
72 | eapply rtc_l; [by constructor|by eapply rtc_nsteps_2]. | ||
73 | + eexists; split_and!; [done|by constructor|]. | ||
74 | eapply rtc_l; [by constructor|by eapply rtc_nsteps_2]. | ||
75 | + inv H2. | ||
76 | * apply IH in H1 as (e'' & Hsteps & ? & ?). | ||
77 | exists e''; split; [|done]. by eapply rtc_l. | ||
78 | * eexists; split_and!; [done|by constructor|]. | ||
79 | eapply rtc_l; [by eapply SAppR|]. by eapply rtc_nsteps_2. | ||
80 | Qed. | ||
81 | |||
82 | Lemma Attr_wp_shallow Φ αs : | ||
83 | Φ (EAttr (AttrN ∘ from_attr (subst (indirects αs)) id <$> αs)) → | ||
84 | wp SHALLOW (EAttr αs) Φ. | ||
85 | Proof. | ||
86 | eexists (EAttr (AttrN ∘ _ <$> αs)); split_and!; [ |by constructor|done]. | ||
87 | destruct (decide (no_recs αs)); [|apply rtc_once; by constructor]. | ||
88 | apply reflexive_eq; f_equal. apply map_eq=> x. rewrite lookup_fmap. | ||
89 | destruct (αs !! x) as [[? e]|] eqn:?; f_equal/=. | ||
90 | by assert (τ = NONREC) as -> by eauto using no_recs_lookup. | ||
91 | Qed. | ||
92 | |||
93 | Lemma β_wp μ Φ x e1 e2 : | ||
94 | wp μ (subst {[x:=(ABS, e2)]} e1) Φ → | ||
95 | wp μ (EApp (EAbs x e1) e2) Φ. | ||
96 | Proof. | ||
97 | intros (e' & Hsteps & ? & ?). exists e'. split; [|done]. | ||
98 | eapply rtc_l; [|done]. by constructor. | ||
99 | Qed. | ||
100 | |||
101 | Lemma βMatch_wp μ Φ ms strict e1 αs βs : | ||
102 | no_recs αs → | ||
103 | matches (attr_expr <$> αs) ms strict βs → | ||
104 | wp μ (subst (indirects βs) e1) Φ → | ||
105 | wp μ (EApp (EAbsMatch ms strict e1) (EAttr αs)) Φ. | ||
106 | Proof. | ||
107 | intros ?? (e' & Hsteps & ? & ?). exists e'. split; [|done]. | ||
108 | eapply rtc_l; [|done]. by constructor. | ||
109 | Qed. | ||
110 | |||
111 | Lemma Functor_wp μ Φ αs e1 e2 : | ||
112 | no_recs αs → | ||
113 | αs !! "__functor" = Some (AttrN e1) → | ||
114 | wp μ (EApp (EApp e1 (EAttr αs)) e2) Φ → | ||
115 | wp μ (EApp (EAttr αs) e2) Φ. | ||
116 | Proof. | ||
117 | intros ?? (e' & Hsteps & ? & ?). exists e'. split; [|done]. | ||
118 | eapply rtc_l; [|done]. by constructor. | ||
119 | Qed. | ||
120 | |||
121 | Lemma If_wp μ Φ e1 e2 e3 : | ||
122 | wp SHALLOW e1 (λ e1', ∃ b : bool, | ||
123 | e1' = ELit (LitBool b) ∧ wp μ (if b then e2 else e3) Φ) → | ||
124 | wp μ (EIf e1 e2 e3) Φ. | ||
125 | Proof. | ||
126 | intros (e1' & Hsteps & ? & b & -> & e' & Hsteps' & ? & HΦ). | ||
127 | exists e'; split; [|done]. etrans; [by apply SIf_rtc|]. | ||
128 | eapply rtc_l; [|done]. destruct b; constructor. | ||
129 | Qed. | ||
130 | |||
131 | Lemma wp_mono μ e Φ Ψ : | ||
132 | wp μ e Φ → | ||
133 | (∀ e', Φ e' → Ψ e') → | ||
134 | wp μ e Ψ. | ||
135 | Proof. intros (e' & ? & ? & ?) ?. exists e'. naive_solver. Qed. | ||
136 | |||
137 | Lemma union_kinded_abs {A} mkv (v2 : A) : | ||
138 | union_kinded (pair WITH <$> mkv) (Some (ABS, v2)) = Some (ABS, v2). | ||
139 | Proof. by destruct mkv. Qed. | ||
140 | |||
141 | Lemma union_kinded_with {A} (v : A) mkv2 : | ||
142 | union_kinded (Some (WITH, v)) (pair WITH <$> mkv2) = Some (WITH, v). | ||
143 | Proof. by destruct mkv2. Qed. | ||
diff --git a/theories/nix/wp_examples.v b/theories/nix/wp_examples.v new file mode 100644 index 0000000..7bc2109 --- /dev/null +++ b/theories/nix/wp_examples.v | |||
@@ -0,0 +1,164 @@ | |||
1 | From mininix Require Import nix.wp nix.notations. | ||
2 | From stdpp Require Import options. | ||
3 | Local Open Scope Z_scope. | ||
4 | |||
5 | Definition test αs := | ||
6 | let: "x" := 1 in | ||
7 | with: EAttr αs in | ||
8 | with: EAttr {[ "y" := AttrN 2 ]} in | ||
9 | "x" =: "y". | ||
10 | |||
11 | Example test_wp μ αs : | ||
12 | no_recs αs → | ||
13 | wp μ (test αs) (.= false). | ||
14 | Proof. | ||
15 | intros Hαs. rewrite /test. apply LetAttr_no_recs_wp. | ||
16 | { by apply no_recs_insert. } | ||
17 | rewrite /= !map_fmap_singleton /= right_id_L lookup_singleton lookup_singleton_ne //=. | ||
18 | apply LetAttr_no_recs_wp. | ||
19 | { by apply no_recs_attr_subst. } | ||
20 | rewrite /= !map_fmap_singleton /= right_id_L. | ||
21 | rewrite (map_fmap_compose attr_expr) lookup_fmap union_kinded_abs. | ||
22 | rewrite !lookup_fmap. | ||
23 | apply LetAttr_no_recs_wp. | ||
24 | { by apply no_recs_insert. } | ||
25 | rewrite /= map_fmap_singleton lookup_singleton lookup_singleton_ne //=. | ||
26 | rewrite union_kinded_with. | ||
27 | apply BinOp_wp. | ||
28 | apply Id_wp, Lit_wp; first done. eexists; split; [constructor|]. | ||
29 | apply Id_wp, Lit_wp; first done. | ||
30 | eexists; split; [done|]. by apply Lit_wp. | ||
31 | Qed. | ||
32 | |||
33 | Definition neg := λ: "b", if: "b" then false else true. | ||
34 | |||
35 | Lemma neg_wp μ (Φ : expr → Prop) e : | ||
36 | wp SHALLOW e (λ e', ∃ b : bool, e' = b ∧ Φ (negb b)) → | ||
37 | wp μ (neg e) Φ. | ||
38 | Proof. | ||
39 | intros Hwp. apply β_wp. rewrite /= lookup_singleton /=. | ||
40 | apply If_wp, Id_wp. eapply wp_mono; [done|]. | ||
41 | intros ? (b & -> & ?). exists b; split; [done|]. | ||
42 | destruct b; by apply Lit_wp. | ||
43 | Qed. | ||
44 | |||
45 | (* rec { f = x: if x = 0 then true else !(f (x - 1)); }.f n *) | ||
46 | Definition even_rec_attr := | ||
47 | EAttr {[ "f" := AttrR (λ: "x", if: "x" =: 0 then true else neg ("f" ("x" -: 1))) ]} .: "f". | ||
48 | |||
49 | Lemma even_rec_attr_wp e n : | ||
50 | 0 ≤ n ≤ int_max → | ||
51 | wp SHALLOW e (.= n) → | ||
52 | wp SHALLOW (even_rec_attr e) (.= Z.even n). | ||
53 | Proof. | ||
54 | intros Hn Hwp. apply App_wp. | ||
55 | revert e Hwp. induction (Z.lt_wf 0 n) as [n _ IH]; intros e Hwp. | ||
56 | apply BinOp_wp. apply Attr_wp_shallow. | ||
57 | eexists; split; [by constructor|]. | ||
58 | apply Lit_wp; [done|]. eexists; split; [by eexists|]. | ||
59 | rewrite /=. apply Abs_wp, β_wp. | ||
60 | rewrite /= !lookup_singleton /= !lookup_singleton_ne //=. | ||
61 | rewrite !union_with_None_l !union_with_None_r. | ||
62 | rewrite /indirects map_imap_insert map_imap_empty lookup_insert. | ||
63 | rewrite -/even_rec_attr -/neg. | ||
64 | apply If_wp, BinOp_wp, Id_wp. | ||
65 | eapply wp_mono; [apply Hwp|]; intros ? ->. | ||
66 | eexists; split; [by constructor|]. | ||
67 | apply Lit_wp; [done|]. eexists; split; [by eexists|]. simpl. | ||
68 | destruct (n =? 0) eqn:Hn0; (apply Lit_wp; [done|]; eexists; split; [done|]; simpl). | ||
69 | { apply Lit_wp; [done|]. by apply Z.eqb_eq in Hn0 as ->. } | ||
70 | apply neg_wp, App_wp, Id_wp. | ||
71 | eapply wp_mono; [apply (IH (n-1))|]; [lia..| |]. | ||
72 | 2:{ intros e' He'. eapply wp_mono; [apply He'|]. | ||
73 | intros ? ->. eexists; split; [done|]. | ||
74 | by rewrite Z.negb_even Z.sub_1_r Z.odd_pred. } | ||
75 | eapply BinOp_wp, Id_wp. eapply wp_mono; [apply Hwp|]. intros ? ->. | ||
76 | eexists; split; [by constructor|]. apply Lit_wp; [done|]. | ||
77 | eexists; split; [eexists _, _; split_and!; [done| |done]|]. | ||
78 | - rewrite /= option_guard_True //. apply bool_decide_pack. | ||
79 | rewrite /int_min Z.shiftl_mul_pow2 //. lia. | ||
80 | - apply Lit_wp; [|done]. apply bool_decide_pack. | ||
81 | rewrite /int_min Z.shiftl_mul_pow2 //. lia. | ||
82 | Qed. | ||
83 | |||
84 | Lemma even_rec_attr_wp' n : | ||
85 | 0 ≤ n ≤ int_max → | ||
86 | wp SHALLOW (even_rec_attr n) (.= Z.even n). | ||
87 | Proof. | ||
88 | intros ?. apply even_rec_attr_wp; [done|]. apply Lit_wp; [|done]. | ||
89 | rewrite /= /int_ok. apply bool_decide_pack. | ||
90 | rewrite /int_min Z.shiftl_mul_pow2 //. lia. | ||
91 | Qed. | ||
92 | |||
93 | (* { "__functor " = r: x: if x == 0 then true else !(r (x - 1)); } n *) | ||
94 | Definition even_rec_functor := | ||
95 | EAttr {[ "__functor" := | ||
96 | AttrN (λ: "r" "x", if: "x" =: 0 then true else neg ("r" ("x" -: 1))) ]}. | ||
97 | |||
98 | Lemma even_rec_functor_wp e n : | ||
99 | 0 ≤ n ≤ int_max → | ||
100 | wp SHALLOW e (.= n) → | ||
101 | wp SHALLOW (even_rec_functor e) (.= Z.even n). | ||
102 | Proof. | ||
103 | intros Hn Hwp. apply App_wp. | ||
104 | revert e Hwp. induction (Z.lt_wf 0 n) as [n _ IH]; intros e Hwp. | ||
105 | apply Attr_wp_shallow. rewrite map_fmap_singleton /=. eapply Functor_wp. | ||
106 | { by apply no_recs_insert. } | ||
107 | { done. } | ||
108 | apply App_wp. apply β_wp. | ||
109 | rewrite /= !lookup_singleton !lookup_singleton_ne //=. apply Abs_wp, β_wp. | ||
110 | rewrite /= !lookup_singleton /= !lookup_singleton_ne //=. | ||
111 | rewrite -/even_rec_functor -/neg. | ||
112 | apply If_wp, BinOp_wp, Id_wp. | ||
113 | eapply wp_mono; [apply Hwp|]; intros ? ->. | ||
114 | eexists; split; [by constructor|]. | ||
115 | apply Lit_wp; [done|]. eexists; split; [by eexists|]. simpl. | ||
116 | destruct (n =? 0) eqn:Hn0; (apply Lit_wp; [done|]; eexists; split; [done|]; simpl). | ||
117 | { apply Lit_wp; [done|]. by apply Z.eqb_eq in Hn0 as ->. } | ||
118 | apply neg_wp, App_wp, Id_wp. | ||
119 | eapply wp_mono; [apply (IH (n-1))|]; [lia..| |]. | ||
120 | 2:{ intros e' He'. eapply wp_mono; [apply He'|]. | ||
121 | intros ? ->. eexists; split; [done|]. | ||
122 | by rewrite Z.negb_even Z.sub_1_r Z.odd_pred. } | ||
123 | eapply BinOp_wp, Id_wp. eapply wp_mono; [apply Hwp|]. intros ? ->. | ||
124 | eexists; split; [by constructor|]. apply Lit_wp; [done|]. | ||
125 | eexists; split; [eexists _, _; split_and!; [done| |done]|]. | ||
126 | - rewrite /= option_guard_True //. apply bool_decide_pack. | ||
127 | rewrite /int_min Z.shiftl_mul_pow2 //. lia. | ||
128 | - apply Lit_wp; [|done]. apply bool_decide_pack. | ||
129 | rewrite /int_min Z.shiftl_mul_pow2 //. lia. | ||
130 | Qed. | ||
131 | |||
132 | Lemma even_rec_functor_wp' n : | ||
133 | 0 ≤ n ≤ int_max → | ||
134 | wp SHALLOW (even_rec_functor n) (.= Z.even n). | ||
135 | Proof. | ||
136 | intros ?. apply even_rec_functor_wp; [done|]. apply Lit_wp; [|done]. | ||
137 | rewrite /= /int_ok. apply bool_decide_pack. | ||
138 | rewrite /int_min Z.shiftl_mul_pow2 //. lia. | ||
139 | Qed. | ||
140 | |||
141 | (* ({ f ? (x: if x == 0 then true else !(f (x - 1))) }: f) {} n *) | ||
142 | Definition even_rec_default := | ||
143 | (λattr: | ||
144 | {[ "f" := Some (λ: "x", if: "x" =: 0 then true else neg ("f" ("x" -: 1))) ]}, "f") | ||
145 | (EAttr ∅). | ||
146 | |||
147 | Lemma even_rec_default_wp e n : | ||
148 | 0 ≤ n ≤ int_max → | ||
149 | wp SHALLOW e (.= n) → | ||
150 | wp SHALLOW (even_rec_default e) (.= Z.even n). | ||
151 | Proof. | ||
152 | intros Hn Hwp. apply App_wp. | ||
153 | eapply βMatch_wp; [done|repeat econstructor|]. simplify_map_eq. | ||
154 | rewrite -/even_rec_attr. by apply Id_wp, App_wp, even_rec_attr_wp. | ||
155 | Qed. | ||
156 | |||
157 | Lemma even_rec_default_wp' n : | ||
158 | 0 ≤ n ≤ int_max → | ||
159 | wp SHALLOW (even_rec_default n) (.= Z.even n). | ||
160 | Proof. | ||
161 | intros ?. apply even_rec_default_wp; [done|]. apply Lit_wp; [|done]. | ||
162 | rewrite /= /int_ok. apply bool_decide_pack. | ||
163 | rewrite /int_min Z.shiftl_mul_pow2 //. lia. | ||
164 | Qed. | ||
diff --git a/theories/res.v b/theories/res.v new file mode 100644 index 0000000..d13bfee --- /dev/null +++ b/theories/res.v | |||
@@ -0,0 +1,75 @@ | |||
1 | From mininix Require Export utils. | ||
2 | From stdpp Require Import options. | ||
3 | |||
4 | Variant res A := | ||
5 | | Res (x : option A) | ||
6 | | NoFuel. | ||
7 | Arguments Res {_} _. | ||
8 | Arguments NoFuel {_}. | ||
9 | |||
10 | Instance res_fail : MFail res := λ {A} _, Res None. | ||
11 | |||
12 | Instance res_mret : MRet res := λ {A} x, Res (Some x). | ||
13 | |||
14 | Instance res_mbind : MBind res := λ {A B} f rx, | ||
15 | match rx with | ||
16 | | Res mx => default mfail (f <$> mx) | ||
17 | | NoFuel => NoFuel | ||
18 | end. | ||
19 | |||
20 | Instance res_fmap : FMap res := λ {A B} f rx, | ||
21 | match rx with | ||
22 | | Res mx => Res (f <$> mx) | ||
23 | | NoFuel => NoFuel | ||
24 | end. | ||
25 | |||
26 | Instance Res_inj A : Inj (=) (=) (@Res A). | ||
27 | Proof. by injection 1. Qed. | ||
28 | |||
29 | Ltac simplify_res := | ||
30 | repeat match goal with | ||
31 | | H : Res _ = mfail |- _ => apply (inj Res) in H | ||
32 | | H : mfail = Res _ |- _ => apply (inj Res) in H | ||
33 | | H : Res _ = mret _ |- _ => apply (inj Res) in H | ||
34 | | H : mret _ = Res _ |- _ => apply (inj Res) in H | ||
35 | | _ => progress simplify_eq/= | ||
36 | end. | ||
37 | |||
38 | Lemma mapM_Res_impl {A B} (f g : A → res B) (xs : list A) ys : | ||
39 | mapM f xs = Res ys → | ||
40 | (∀ x y, f x = Res y → g x = Res y) → | ||
41 | mapM g xs = Res ys. | ||
42 | Proof. | ||
43 | intros Hxs Hf. revert ys Hxs. | ||
44 | induction xs as [|x xs IH]; intros ys ?; simplify_res; [done|]. | ||
45 | destruct (f x) as [my|] eqn:?; simplify_res. rewrite (Hf x my) //=. | ||
46 | destruct my as [y|]; simplify_res; [|done]. | ||
47 | destruct (mapM f _) as [mys|]; simplify_res; [|done..]. | ||
48 | by rewrite (IH _ eq_refl). | ||
49 | Qed. | ||
50 | |||
51 | Lemma map_mapM_sorted_Res_impl `{FinMap K M} | ||
52 | (R : relation K) `{!RelDecision R, !PartialOrder R, !Total R} | ||
53 | {A B} (f g : A → res B) (m1 : M A) m2 : | ||
54 | map_mapM_sorted R f m1 = Res m2 → | ||
55 | (∀ x y, f x = Res y → g x = Res y) → | ||
56 | map_mapM_sorted R g m1 = Res m2. | ||
57 | Proof. | ||
58 | intros Hm Hf. revert m2 Hm. | ||
59 | induction m1 as [|i x m1 ?? IH] using (map_sorted_ind R); intros m2. | ||
60 | { by rewrite !map_mapM_sorted_empty. } | ||
61 | rewrite !map_mapM_sorted_insert //. intros. | ||
62 | destruct (f x) as [my|] eqn:?; simplify_res. rewrite (Hf x my) //=. | ||
63 | destruct my as [y|]; simplify_res; [|done]. | ||
64 | destruct (map_mapM_sorted _ f _) as [mm2'|]; simplify_res; [|done..]. | ||
65 | by rewrite (IH _ eq_refl). | ||
66 | Qed. | ||
67 | |||
68 | Lemma mapM_res_app {A B} (f : A → res B) xs1 xs2 : | ||
69 | mapM f (xs1 ++ xs2) = ys1 ← mapM f xs1; ys2 ← mapM f xs2; mret (ys1 ++ ys2). | ||
70 | Proof. | ||
71 | induction xs1 as [|x1 xs1 IH]; simpl. | ||
72 | { by destruct (mapM f xs2) as [[]|]. } | ||
73 | destruct (f x1) as [[y1|]|]; simpl; [|done..]. | ||
74 | rewrite IH. by destruct (mapM f xs1) as [[]|], (mapM f xs2) as [[]|]. | ||
75 | Qed. | ||
diff --git a/theories/utils.v b/theories/utils.v new file mode 100644 index 0000000..0cb1b33 --- /dev/null +++ b/theories/utils.v | |||
@@ -0,0 +1,275 @@ | |||
1 | (* Stuff that should be upstreamed to std++ *) | ||
2 | From stdpp Require Export gmap stringmap ssreflect. | ||
3 | From stdpp Require Import sorting. | ||
4 | From stdpp Require Import options. | ||
5 | Set Default Proof Using "Type*". | ||
6 | |||
7 | (* Succeeds if [t] is syntactically a constructor applied to some arguments. | ||
8 | Note that Coq's [is_constructor] succeeds on [S], but fails on [S n]. *) | ||
9 | Ltac is_app_constructor t := | ||
10 | lazymatch t with | ||
11 | | ?t _ => is_app_constructor t | ||
12 | | _ => is_constructor t | ||
13 | end. | ||
14 | |||
15 | Lemma xorb_True b1 b2 : xorb b1 b2 ↔ ¬(b1 ↔ b2). | ||
16 | Proof. destruct b1, b2; naive_solver. Qed. | ||
17 | |||
18 | Definition option_to_eq_Some {A} (mx : option A) : option { x | mx = Some x } := | ||
19 | match mx with | ||
20 | | Some x => Some (x ↾ eq_refl) | ||
21 | | None => None | ||
22 | end. | ||
23 | |||
24 | (* Premise can probably be weakened to something with [ProofIrrel]. *) | ||
25 | Lemma option_to_eq_Some_Some `{!EqDecision A} (mx : option A) x (H : mx = Some x) : | ||
26 | option_to_eq_Some mx = Some (x ↾ H). | ||
27 | Proof. | ||
28 | destruct mx as [x'|]; simplify_eq/=; f_equal/=. | ||
29 | assert (x' = x) as Hx by congruence. destruct Hx. | ||
30 | f_equal. apply (proof_irrel _). | ||
31 | Qed. | ||
32 | |||
33 | Definition from_sum {A B C} (f : A → C) (g : B → C) (xy : A + B) : C := | ||
34 | match xy with inl x => f x | inr y => g y end. | ||
35 | |||
36 | Global Instance maybe_String : Maybe2 String := λ s, | ||
37 | if s is String a s then Some (a,s) else None. | ||
38 | |||
39 | Global Instance String_inj a : Inj (=) (=) (String a). | ||
40 | Proof. by injection 1. Qed. | ||
41 | |||
42 | Global Instance full_relation_dec {A} : RelDecision (λ _ _ : A, True). | ||
43 | Proof. unfold RelDecision. apply _. Defined. | ||
44 | |||
45 | Global Instance prod_relation_dec `{RA : relation A, RB : relation B} : | ||
46 | RelDecision RA → RelDecision RB → RelDecision (prod_relation RA RB). | ||
47 | Proof. unfold RelDecision. apply _. Defined. | ||
48 | |||
49 | Global Hint Extern 0 (from_option _ _ _) => progress simpl : core. | ||
50 | |||
51 | Definition map_sum_with `{MapFold K A M} (f : A → nat) : M → nat := | ||
52 | map_fold (λ _, plus ∘ f) 0. | ||
53 | Lemma map_sum_with_lookup_le `{FinMap K M} {A} (f : A → nat) (m : M A) i x : | ||
54 | m !! i = Some x → f x ≤ map_sum_with f m. | ||
55 | Proof. | ||
56 | intros. rewrite /map_sum_with (map_fold_delete_L _ _ i x m) /=; auto with lia. | ||
57 | Qed. | ||
58 | |||
59 | Lemma map_Forall2_dom `{FinMapDom K M C} {A B} (P : K → A → B → Prop) | ||
60 | (m1 : M A) (m2 : M B) : | ||
61 | map_Forall2 P m1 m2 → dom m1 ≡ dom m2. | ||
62 | Proof. | ||
63 | revert m2. induction m1 as [|i x1 m1 ? IH] using map_ind; intros m2. | ||
64 | { intros ->%map_Forall2_empty_inv_l. by rewrite !dom_empty. } | ||
65 | intros (x2 & m2' & -> & ? & ? & ?)%map_Forall2_insert_inv_l; last done. | ||
66 | rewrite !dom_insert IH //. | ||
67 | Qed. | ||
68 | Lemma map_Forall2_dom_L `{FinMapDom K M C, !LeibnizEquiv C} {A B} | ||
69 | (P : K → A → B → Prop) (m1 : M A) (m2 : M B) : | ||
70 | map_Forall2 P m1 m2 → dom m1 = dom m2. | ||
71 | Proof. unfold_leibniz. apply map_Forall2_dom. Qed. | ||
72 | |||
73 | Definition map_mapM | ||
74 | `{!∀ A, MapFold K A (M A), !∀ A, Empty (M A), !∀ A, Insert K A (M A)} | ||
75 | `{MBind F, MRet F} {A B} (f : A → F B) (m : M A) : F (M B) := | ||
76 | map_fold (λ i x mm, y ← f x; m ← mm; mret $ <[i:=y]> m) (mret ∅) m. | ||
77 | |||
78 | Section fin_map. | ||
79 | Context `{FinMap K M}. | ||
80 | |||
81 | Lemma map_insert_inv_eq {A} {m1 m2 : M A} x v u : | ||
82 | m1 !! x = None → | ||
83 | m2 !! x = None → | ||
84 | <[x:=v]> m1 = <[x:=u]> m2 → | ||
85 | v = u ∧ m1 = m2. | ||
86 | Proof. | ||
87 | intros Hm1 Hm2 Heq. split. | ||
88 | - assert (Huv : <[x:=v]> m1 !! x = Some v). { apply lookup_insert. } | ||
89 | rewrite Heq lookup_insert in Huv. by injection Huv as ->. | ||
90 | - apply map_eq. intros i. | ||
91 | replace m1 with (delete x (<[x:=v]> m1)) by (apply delete_insert; done). | ||
92 | replace m2 with (delete x (<[x:=u]> m2)) by (apply delete_insert; done). | ||
93 | by rewrite Heq. | ||
94 | Qed. | ||
95 | |||
96 | Lemma map_insert_inv_ne {A} {m1 m2 : M A} x1 x2 v1 v2 : | ||
97 | x1 ≠ x2 → | ||
98 | m1 !! x1 = None → | ||
99 | m2 !! x2 = None → | ||
100 | <[x1:=v1]> m1 = <[x2:=v2]> m2 → | ||
101 | m1 !! x2 = Some v2 ∧ m2 !! x1 = Some v1 ∧ delete x2 m1 = delete x1 m2. | ||
102 | Proof. | ||
103 | intros Hx1x2 Hm1 Hm2 Hm1m2. rewrite map_eq_iff in Hm1m2. split_and!. | ||
104 | - rewrite -(lookup_insert_ne _ x1 _ v1) // Hm1m2 lookup_insert //. | ||
105 | - rewrite -(lookup_insert_ne _ x2 _ v2) // -Hm1m2 lookup_insert //. | ||
106 | - apply map_eq. intros y. destruct (decide (y = x1)) as [->|]; | ||
107 | first rewrite lookup_delete_ne // lookup_delete //. | ||
108 | destruct (decide (y = x2)) as [->|]; | ||
109 | first rewrite lookup_delete lookup_delete_ne //. | ||
110 | rewrite !lookup_delete_ne // | ||
111 | -(lookup_insert_ne m2 x2 _ v2) // | ||
112 | -(lookup_insert_ne m1 x1 _ v1) //. | ||
113 | Qed. | ||
114 | |||
115 | Lemma map_mapM_empty `{MBind F, MRet F} {A B} (f : A → F B) : | ||
116 | map_mapM f (∅ : M A) =@{F (M B)} mret ∅. | ||
117 | Proof. unfold map_mapM. by rewrite map_fold_empty. Qed. | ||
118 | |||
119 | Lemma map_mapM_insert `{MBind F, MRet F} {A B} (f : A → F B) (m : M A) i x : | ||
120 | m !! i = None → map_first_key (<[i:=x]> m) i → | ||
121 | map_mapM f (<[i:=x]> m) = y ← f x; m ← map_mapM f m; mret $ <[i:=y]> m. | ||
122 | Proof. intros. rewrite /map_mapM map_fold_insert_first_key //. Qed. | ||
123 | |||
124 | Lemma map_mapM_insert_option {A B} (f : A → option B) (m : M A) i x : | ||
125 | m !! i = None → | ||
126 | map_mapM f (<[i:=x]> m) = y ← f x; m ← map_mapM f m; mret $ <[i:=y]> m. | ||
127 | Proof. | ||
128 | intros. apply: map_fold_insert; [|done]. | ||
129 | intros ?? z1 z2 my ???. destruct (f z1), (f z2), my; f_equal/=. | ||
130 | by apply insert_commute. | ||
131 | Qed. | ||
132 | End fin_map. | ||
133 | |||
134 | Definition map_minimal_key `{MapFold K A M} (R : relation K) `{!RelDecision R} | ||
135 | (m : M) : option K := | ||
136 | map_fold (λ i _ mj, | ||
137 | match mj with | ||
138 | | Some j => if decide (R i j) then Some i else Some j | ||
139 | | None => Some i | ||
140 | end) None m. | ||
141 | |||
142 | Section map_sorted. | ||
143 | Context `{FinMap K M} (R : relation K) . | ||
144 | |||
145 | Lemma map_minimal_key_None {A} `{!RelDecision R} (m : M A) : | ||
146 | map_minimal_key R m = None ↔ m = ∅. | ||
147 | Proof. | ||
148 | split; [|intros ->; apply map_fold_empty]. | ||
149 | induction m as [|j x m ?? _] using map_first_key_ind; intros Hm; [done|]. | ||
150 | rewrite /map_minimal_key map_fold_insert_first_key // in Hm. | ||
151 | repeat case_match; simplify_option_eq. | ||
152 | Qed. | ||
153 | |||
154 | Lemma map_minimal_key_Some_1 {A} `{!RelDecision R, !PreOrder R, !Total R} | ||
155 | (m : M A) i : | ||
156 | map_minimal_key R m = Some i → | ||
157 | is_Some (m !! i) ∧ ∀ j, is_Some (m !! j) → R i j. | ||
158 | Proof. | ||
159 | revert i. induction m as [|j x m ?? IH] using map_first_key_ind; intros i Hm. | ||
160 | { by rewrite /map_minimal_key map_fold_empty in Hm. } | ||
161 | rewrite /map_minimal_key map_fold_insert_first_key // in Hm. | ||
162 | destruct (map_fold _ _ m) as [i'|] eqn:Hfold; simplify_eq. | ||
163 | - apply IH in Hfold as [??]. rewrite lookup_insert_is_Some. | ||
164 | case_decide as HR; simplify_eq/=. | ||
165 | + split; [by auto|]. intros j [->|[??]]%lookup_insert_is_Some; [done|]. | ||
166 | trans i'; eauto. | ||
167 | + split. | ||
168 | { right; split; [|done]. intros ->. by destruct HR. } | ||
169 | intros j' [->|[??]]%lookup_insert_is_Some; [|by eauto]. | ||
170 | by destruct (total R i j'). | ||
171 | - apply map_minimal_key_None in Hfold as ->. | ||
172 | split; [rewrite lookup_insert; by eauto|]. | ||
173 | intros j' [->|[? Hj']]%lookup_insert_is_Some; [done|]. | ||
174 | rewrite lookup_empty in Hj'. by destruct Hj'. | ||
175 | Qed. | ||
176 | |||
177 | Lemma map_minimal_key_Some {A} `{!RelDecision R, !PartialOrder R, !Total R} | ||
178 | (m : M A) i : | ||
179 | map_minimal_key R m = Some i ↔ | ||
180 | is_Some (m !! i) ∧ ∀ j, is_Some (m !! j) → R i j. | ||
181 | Proof. | ||
182 | split; [apply map_minimal_key_Some_1|]. | ||
183 | intros [Hi ?]. destruct (map_minimal_key R m) as [i'|] eqn:Hmin. | ||
184 | - f_equal. apply map_minimal_key_Some_1 in Hmin as [??]. | ||
185 | apply (anti_symm R); eauto. | ||
186 | - apply map_minimal_key_None in Hmin as ->. | ||
187 | rewrite lookup_empty in Hi. by destruct Hi. | ||
188 | Qed. | ||
189 | |||
190 | Lemma map_sorted_ind {A} `{!PreOrder R, !Total R} (P : M A → Prop) : | ||
191 | P ∅ → | ||
192 | (∀ i x m, | ||
193 | m !! i = None → | ||
194 | (∀ j, is_Some (m !! j) → R i j) → | ||
195 | P m → | ||
196 | P (<[i:=x]> m)) → | ||
197 | (∀ m, P m). | ||
198 | Proof. | ||
199 | intros Hemp Hins m. induction (Nat.lt_wf_0_projected size m) as [m _ IH]. | ||
200 | cut (m = ∅ ∨ map_Exists (λ i _, ∀ j, is_Some (m !! j) → R i j) m). | ||
201 | { intros [->|(i & x & Hi & ?)]; [done|]. rewrite -(insert_delete m i x) //. | ||
202 | apply Hins; [by rewrite lookup_delete|..]. | ||
203 | - intros j ?%lookup_delete_is_Some. naive_solver. | ||
204 | - apply IH. | ||
205 | rewrite -{2}(insert_delete m i x) // map_size_insert lookup_delete. lia. } | ||
206 | clear P Hemp Hins IH. induction m as [|i x m ? IH] using map_ind; [by auto|]. | ||
207 | right. destruct IH as [->|(i' & x' & ? & ?)]. | ||
208 | { rewrite insert_empty map_Exists_singleton. | ||
209 | by intros j [y [-> ->]%lookup_singleton_Some]. } | ||
210 | apply map_Exists_insert; first done. destruct (total R i i'). | ||
211 | - left. intros j [->|[??]]%lookup_insert_is_Some; [done|]. trans i'; eauto. | ||
212 | - right. exists i', x'. split; [done|]. | ||
213 | intros j [->|[??]]%lookup_insert_is_Some; eauto. | ||
214 | Qed. | ||
215 | End map_sorted. | ||
216 | |||
217 | Definition map_fold_sorted `{!MapFold K A M} {B} | ||
218 | (R : relation K) `{!RelDecision R} | ||
219 | (f : K → A → B → B) (b : B) | ||
220 | (m : M) : B := foldr (λ '(i,x), f i x) b $ | ||
221 | merge_sort (prod_relation R (λ _ _, True)) (map_to_list m). | ||
222 | |||
223 | Definition map_mapM_sorted | ||
224 | `{!∀ A, MapFold K A (M A), !∀ A, Empty (M A), !∀ A, Insert K A (M A)} | ||
225 | `{MBind F, MRet F} {A B} | ||
226 | (R : relation K) `{!RelDecision R} | ||
227 | (f : A → F B) (m : M A) : F (M B) := | ||
228 | map_fold_sorted R (λ i x mm, y ← f x; m ← mm; mret $ <[i:=y]> m) (mret ∅) m. | ||
229 | |||
230 | Section fin_map. | ||
231 | Context `{FinMap K M}. | ||
232 | Context (R : relation K) `{!RelDecision R, !PartialOrder R, !Total R}. | ||
233 | |||
234 | Lemma map_fold_sorted_empty {A B} (f : K → A → B → B) b : | ||
235 | map_fold_sorted R f b (∅ : M A) = b. | ||
236 | Proof. by rewrite /map_fold_sorted map_to_list_empty. Qed. | ||
237 | |||
238 | Lemma map_fold_sorted_insert {A B} (f : K → A → B → B) (m : M A) b i x : | ||
239 | m !! i = None → (∀ j, is_Some (m !! j) → R i j) → | ||
240 | map_fold_sorted R f b (<[i:=x]> m) = f i x (map_fold_sorted R f b m). | ||
241 | Proof. | ||
242 | intros Hi Hleast. unfold map_fold_sorted. | ||
243 | set (R' := prod_relation R _). | ||
244 | assert (PreOrder R'). | ||
245 | { split; [done|]. | ||
246 | intros [??] [??] [??] [??] [??]; split; [by etrans|done]. } | ||
247 | assert (Total R'). | ||
248 | { intros [i1 ?] [i2 ?]. destruct (total R i1 i2); [by left|by right]. } | ||
249 | assert (merge_sort R' (map_to_list (<[i:=x]> m)) | ||
250 | = (i,x) :: merge_sort R' (map_to_list m)) as ->; [|done]. | ||
251 | eapply (Sorted_unique_strong R'). | ||
252 | - intros [i1 y1] [i2 y2]. | ||
253 | rewrite !merge_sort_Permutation elem_of_cons !elem_of_map_to_list. | ||
254 | rewrite lookup_insert_Some. intros ?? [? _] [? _]. | ||
255 | assert (i1 = i2) as -> by (by apply (anti_symm R)); naive_solver. | ||
256 | - apply (Sorted_merge_sort _). | ||
257 | - apply Sorted_cons; [apply (Sorted_merge_sort _)|]. | ||
258 | destruct (merge_sort R' (map_to_list m)) | ||
259 | as [|[i' x'] ixs] eqn:Hixs; repeat constructor; simpl. | ||
260 | apply Hleast. exists x'. apply elem_of_map_to_list. | ||
261 | rewrite -(merge_sort_Permutation R' (map_to_list m)) Hixs. left. | ||
262 | - by rewrite !merge_sort_Permutation map_to_list_insert. | ||
263 | Qed. | ||
264 | |||
265 | Lemma map_mapM_sorted_empty `{MBind F, MRet F} {A B} (f : A → F B) : | ||
266 | map_mapM_sorted R f (∅ : M A) =@{F (M B)} mret ∅. | ||
267 | Proof. by rewrite /map_mapM_sorted map_fold_sorted_empty. Qed. | ||
268 | |||
269 | Lemma map_mapM_sorted_insert `{MBind F, MRet F} | ||
270 | {A B} (f : A → F B) (m : M A) i x : | ||
271 | m !! i = None → (∀ j, is_Some (m !! j) → R i j) → | ||
272 | map_mapM_sorted R f (<[i:=x]> m) | ||
273 | = y ← f x; m ← map_mapM_sorted R f m; mret $ <[i:=y]> m. | ||
274 | Proof. intros. by rewrite /map_mapM_sorted map_fold_sorted_insert. Qed. | ||
275 | End fin_map. | ||