├── .gitignore ├── LICENSE ├── README.md ├── STLC ├── Category.agda ├── Equivalence.agda ├── nbe.agda ├── nbe.py ├── stlc.agda └── substitution.agda ├── SystemF └── SystemF.agda ├── combinator.agda ├── nbe.agda ├── nbe.py └── reduce.agda /.gitignore: -------------------------------------------------------------------------------- 1 | *.agdai -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 3, 29 June 2007 3 | 4 | Copyright (C) 2007 Free Software Foundation, Inc. 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | The GNU General Public License is a free, copyleft license for 11 | software and other kinds of works. 12 | 13 | The licenses for most software and other practical works are designed 14 | to take away your freedom to share and change the works. By contrast, 15 | the GNU General Public License is intended to guarantee your freedom to 16 | share and change all versions of a program--to make sure it remains free 17 | software for all its users. We, the Free Software Foundation, use the 18 | GNU General Public License for most of our software; it applies also to 19 | any other work released this way by its authors. You can apply it to 20 | your programs, too. 21 | 22 | When we speak of free software, we are referring to freedom, not 23 | price. Our General Public Licenses are designed to make sure that you 24 | have the freedom to distribute copies of free software (and charge for 25 | them if you wish), that you receive source code or can get it if you 26 | want it, that you can change the software or use pieces of it in new 27 | free programs, and that you know you can do these things. 28 | 29 | To protect your rights, we need to prevent others from denying you 30 | these rights or asking you to surrender the rights. Therefore, you have 31 | certain responsibilities if you distribute copies of the software, or if 32 | you modify it: responsibilities to respect the freedom of others. 33 | 34 | For example, if you distribute copies of such a program, whether 35 | gratis or for a fee, you must pass on to the recipients the same 36 | freedoms that you received. You must make sure that they, too, receive 37 | or can get the source code. And you must show them these terms so they 38 | know their rights. 39 | 40 | Developers that use the GNU GPL protect your rights with two steps: 41 | (1) assert copyright on the software, and (2) offer you this License 42 | giving you legal permission to copy, distribute and/or modify it. 43 | 44 | For the developers' and authors' protection, the GPL clearly explains 45 | that there is no warranty for this free software. For both users' and 46 | authors' sake, the GPL requires that modified versions be marked as 47 | changed, so that their problems will not be attributed erroneously to 48 | authors of previous versions. 49 | 50 | Some devices are designed to deny users access to install or run 51 | modified versions of the software inside them, although the manufacturer 52 | can do so. This is fundamentally incompatible with the aim of 53 | protecting users' freedom to change the software. The systematic 54 | pattern of such abuse occurs in the area of products for individuals to 55 | use, which is precisely where it is most unacceptable. Therefore, we 56 | have designed this version of the GPL to prohibit the practice for those 57 | products. If such problems arise substantially in other domains, we 58 | stand ready to extend this provision to those domains in future versions 59 | of the GPL, as needed to protect the freedom of users. 60 | 61 | Finally, every program is threatened constantly by software patents. 62 | States should not allow patents to restrict development and use of 63 | software on general-purpose computers, but in those that do, we wish to 64 | avoid the special danger that patents applied to a free program could 65 | make it effectively proprietary. To prevent this, the GPL assures that 66 | patents cannot be used to render the program non-free. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | TERMS AND CONDITIONS 72 | 73 | 0. Definitions. 74 | 75 | "This License" refers to version 3 of the GNU General Public License. 76 | 77 | "Copyright" also means copyright-like laws that apply to other kinds of 78 | works, such as semiconductor masks. 79 | 80 | "The Program" refers to any copyrightable work licensed under this 81 | License. Each licensee is addressed as "you". "Licensees" and 82 | "recipients" may be individuals or organizations. 83 | 84 | To "modify" a work means to copy from or adapt all or part of the work 85 | in a fashion requiring copyright permission, other than the making of an 86 | exact copy. The resulting work is called a "modified version" of the 87 | earlier work or a work "based on" the earlier work. 88 | 89 | A "covered work" means either the unmodified Program or a work based 90 | on the Program. 91 | 92 | To "propagate" a work means to do anything with it that, without 93 | permission, would make you directly or secondarily liable for 94 | infringement under applicable copyright law, except executing it on a 95 | computer or modifying a private copy. Propagation includes copying, 96 | distribution (with or without modification), making available to the 97 | public, and in some countries other activities as well. 98 | 99 | To "convey" a work means any kind of propagation that enables other 100 | parties to make or receive copies. Mere interaction with a user through 101 | a computer network, with no transfer of a copy, is not conveying. 102 | 103 | An interactive user interface displays "Appropriate Legal Notices" 104 | to the extent that it includes a convenient and prominently visible 105 | feature that (1) displays an appropriate copyright notice, and (2) 106 | tells the user that there is no warranty for the work (except to the 107 | extent that warranties are provided), that licensees may convey the 108 | work under this License, and how to view a copy of this License. If 109 | the interface presents a list of user commands or options, such as a 110 | menu, a prominent item in the list meets this criterion. 111 | 112 | 1. Source Code. 113 | 114 | The "source code" for a work means the preferred form of the work 115 | for making modifications to it. "Object code" means any non-source 116 | form of a work. 117 | 118 | A "Standard Interface" means an interface that either is an official 119 | standard defined by a recognized standards body, or, in the case of 120 | interfaces specified for a particular programming language, one that 121 | is widely used among developers working in that language. 122 | 123 | The "System Libraries" of an executable work include anything, other 124 | than the work as a whole, that (a) is included in the normal form of 125 | packaging a Major Component, but which is not part of that Major 126 | Component, and (b) serves only to enable use of the work with that 127 | Major Component, or to implement a Standard Interface for which an 128 | implementation is available to the public in source code form. A 129 | "Major Component", in this context, means a major essential component 130 | (kernel, window system, and so on) of the specific operating system 131 | (if any) on which the executable work runs, or a compiler used to 132 | produce the work, or an object code interpreter used to run it. 133 | 134 | The "Corresponding Source" for a work in object code form means all 135 | the source code needed to generate, install, and (for an executable 136 | work) run the object code and to modify the work, including scripts to 137 | control those activities. However, it does not include the work's 138 | System Libraries, or general-purpose tools or generally available free 139 | programs which are used unmodified in performing those activities but 140 | which are not part of the work. For example, Corresponding Source 141 | includes interface definition files associated with source files for 142 | the work, and the source code for shared libraries and dynamically 143 | linked subprograms that the work is specifically designed to require, 144 | such as by intimate data communication or control flow between those 145 | subprograms and other parts of the work. 146 | 147 | The Corresponding Source need not include anything that users 148 | can regenerate automatically from other parts of the Corresponding 149 | Source. 150 | 151 | The Corresponding Source for a work in source code form is that 152 | same work. 153 | 154 | 2. Basic Permissions. 155 | 156 | All rights granted under this License are granted for the term of 157 | copyright on the Program, and are irrevocable provided the stated 158 | conditions are met. This License explicitly affirms your unlimited 159 | permission to run the unmodified Program. The output from running a 160 | covered work is covered by this License only if the output, given its 161 | content, constitutes a covered work. This License acknowledges your 162 | rights of fair use or other equivalent, as provided by copyright law. 163 | 164 | You may make, run and propagate covered works that you do not 165 | convey, without conditions so long as your license otherwise remains 166 | in force. You may convey covered works to others for the sole purpose 167 | of having them make modifications exclusively for you, or provide you 168 | with facilities for running those works, provided that you comply with 169 | the terms of this License in conveying all material for which you do 170 | not control copyright. Those thus making or running the covered works 171 | for you must do so exclusively on your behalf, under your direction 172 | and control, on terms that prohibit them from making any copies of 173 | your copyrighted material outside their relationship with you. 174 | 175 | Conveying under any other circumstances is permitted solely under 176 | the conditions stated below. Sublicensing is not allowed; section 10 177 | makes it unnecessary. 178 | 179 | 3. Protecting Users' Legal Rights From Anti-Circumvention Law. 180 | 181 | No covered work shall be deemed part of an effective technological 182 | measure under any applicable law fulfilling obligations under article 183 | 11 of the WIPO copyright treaty adopted on 20 December 1996, or 184 | similar laws prohibiting or restricting circumvention of such 185 | measures. 186 | 187 | When you convey a covered work, you waive any legal power to forbid 188 | circumvention of technological measures to the extent such circumvention 189 | is effected by exercising rights under this License with respect to 190 | the covered work, and you disclaim any intention to limit operation or 191 | modification of the work as a means of enforcing, against the work's 192 | users, your or third parties' legal rights to forbid circumvention of 193 | technological measures. 194 | 195 | 4. Conveying Verbatim Copies. 196 | 197 | You may convey verbatim copies of the Program's source code as you 198 | receive it, in any medium, provided that you conspicuously and 199 | appropriately publish on each copy an appropriate copyright notice; 200 | keep intact all notices stating that this License and any 201 | non-permissive terms added in accord with section 7 apply to the code; 202 | keep intact all notices of the absence of any warranty; and give all 203 | recipients a copy of this License along with the Program. 204 | 205 | You may charge any price or no price for each copy that you convey, 206 | and you may offer support or warranty protection for a fee. 207 | 208 | 5. Conveying Modified Source Versions. 209 | 210 | You may convey a work based on the Program, or the modifications to 211 | produce it from the Program, in the form of source code under the 212 | terms of section 4, provided that you also meet all of these conditions: 213 | 214 | a) The work must carry prominent notices stating that you modified 215 | it, and giving a relevant date. 216 | 217 | b) The work must carry prominent notices stating that it is 218 | released under this License and any conditions added under section 219 | 7. This requirement modifies the requirement in section 4 to 220 | "keep intact all notices". 221 | 222 | c) You must license the entire work, as a whole, under this 223 | License to anyone who comes into possession of a copy. This 224 | License will therefore apply, along with any applicable section 7 225 | additional terms, to the whole of the work, and all its parts, 226 | regardless of how they are packaged. This License gives no 227 | permission to license the work in any other way, but it does not 228 | invalidate such permission if you have separately received it. 229 | 230 | d) If the work has interactive user interfaces, each must display 231 | Appropriate Legal Notices; however, if the Program has interactive 232 | interfaces that do not display Appropriate Legal Notices, your 233 | work need not make them do so. 234 | 235 | A compilation of a covered work with other separate and independent 236 | works, which are not by their nature extensions of the covered work, 237 | and which are not combined with it such as to form a larger program, 238 | in or on a volume of a storage or distribution medium, is called an 239 | "aggregate" if the compilation and its resulting copyright are not 240 | used to limit the access or legal rights of the compilation's users 241 | beyond what the individual works permit. Inclusion of a covered work 242 | in an aggregate does not cause this License to apply to the other 243 | parts of the aggregate. 244 | 245 | 6. Conveying Non-Source Forms. 246 | 247 | You may convey a covered work in object code form under the terms 248 | of sections 4 and 5, provided that you also convey the 249 | machine-readable Corresponding Source under the terms of this License, 250 | in one of these ways: 251 | 252 | a) Convey the object code in, or embodied in, a physical product 253 | (including a physical distribution medium), accompanied by the 254 | Corresponding Source fixed on a durable physical medium 255 | customarily used for software interchange. 256 | 257 | b) Convey the object code in, or embodied in, a physical product 258 | (including a physical distribution medium), accompanied by a 259 | written offer, valid for at least three years and valid for as 260 | long as you offer spare parts or customer support for that product 261 | model, to give anyone who possesses the object code either (1) a 262 | copy of the Corresponding Source for all the software in the 263 | product that is covered by this License, on a durable physical 264 | medium customarily used for software interchange, for a price no 265 | more than your reasonable cost of physically performing this 266 | conveying of source, or (2) access to copy the 267 | Corresponding Source from a network server at no charge. 268 | 269 | c) Convey individual copies of the object code with a copy of the 270 | written offer to provide the Corresponding Source. This 271 | alternative is allowed only occasionally and noncommercially, and 272 | only if you received the object code with such an offer, in accord 273 | with subsection 6b. 274 | 275 | d) Convey the object code by offering access from a designated 276 | place (gratis or for a charge), and offer equivalent access to the 277 | Corresponding Source in the same way through the same place at no 278 | further charge. You need not require recipients to copy the 279 | Corresponding Source along with the object code. If the place to 280 | copy the object code is a network server, the Corresponding Source 281 | may be on a different server (operated by you or a third party) 282 | that supports equivalent copying facilities, provided you maintain 283 | clear directions next to the object code saying where to find the 284 | Corresponding Source. Regardless of what server hosts the 285 | Corresponding Source, you remain obligated to ensure that it is 286 | available for as long as needed to satisfy these requirements. 287 | 288 | e) Convey the object code using peer-to-peer transmission, provided 289 | you inform other peers where the object code and Corresponding 290 | Source of the work are being offered to the general public at no 291 | charge under subsection 6d. 292 | 293 | A separable portion of the object code, whose source code is excluded 294 | from the Corresponding Source as a System Library, need not be 295 | included in conveying the object code work. 296 | 297 | A "User Product" is either (1) a "consumer product", which means any 298 | tangible personal property which is normally used for personal, family, 299 | or household purposes, or (2) anything designed or sold for incorporation 300 | into a dwelling. In determining whether a product is a consumer product, 301 | doubtful cases shall be resolved in favor of coverage. For a particular 302 | product received by a particular user, "normally used" refers to a 303 | typical or common use of that class of product, regardless of the status 304 | of the particular user or of the way in which the particular user 305 | actually uses, or expects or is expected to use, the product. A product 306 | is a consumer product regardless of whether the product has substantial 307 | commercial, industrial or non-consumer uses, unless such uses represent 308 | the only significant mode of use of the product. 309 | 310 | "Installation Information" for a User Product means any methods, 311 | procedures, authorization keys, or other information required to install 312 | and execute modified versions of a covered work in that User Product from 313 | a modified version of its Corresponding Source. The information must 314 | suffice to ensure that the continued functioning of the modified object 315 | code is in no case prevented or interfered with solely because 316 | modification has been made. 317 | 318 | If you convey an object code work under this section in, or with, or 319 | specifically for use in, a User Product, and the conveying occurs as 320 | part of a transaction in which the right of possession and use of the 321 | User Product is transferred to the recipient in perpetuity or for a 322 | fixed term (regardless of how the transaction is characterized), the 323 | Corresponding Source conveyed under this section must be accompanied 324 | by the Installation Information. But this requirement does not apply 325 | if neither you nor any third party retains the ability to install 326 | modified object code on the User Product (for example, the work has 327 | been installed in ROM). 328 | 329 | The requirement to provide Installation Information does not include a 330 | requirement to continue to provide support service, warranty, or updates 331 | for a work that has been modified or installed by the recipient, or for 332 | the User Product in which it has been modified or installed. Access to a 333 | network may be denied when the modification itself materially and 334 | adversely affects the operation of the network or violates the rules and 335 | protocols for communication across the network. 336 | 337 | Corresponding Source conveyed, and Installation Information provided, 338 | in accord with this section must be in a format that is publicly 339 | documented (and with an implementation available to the public in 340 | source code form), and must require no special password or key for 341 | unpacking, reading or copying. 342 | 343 | 7. Additional Terms. 344 | 345 | "Additional permissions" are terms that supplement the terms of this 346 | License by making exceptions from one or more of its conditions. 347 | Additional permissions that are applicable to the entire Program shall 348 | be treated as though they were included in this License, to the extent 349 | that they are valid under applicable law. If additional permissions 350 | apply only to part of the Program, that part may be used separately 351 | under those permissions, but the entire Program remains governed by 352 | this License without regard to the additional permissions. 353 | 354 | When you convey a copy of a covered work, you may at your option 355 | remove any additional permissions from that copy, or from any part of 356 | it. (Additional permissions may be written to require their own 357 | removal in certain cases when you modify the work.) You may place 358 | additional permissions on material, added by you to a covered work, 359 | for which you have or can give appropriate copyright permission. 360 | 361 | Notwithstanding any other provision of this License, for material you 362 | add to a covered work, you may (if authorized by the copyright holders of 363 | that material) supplement the terms of this License with terms: 364 | 365 | a) Disclaiming warranty or limiting liability differently from the 366 | terms of sections 15 and 16 of this License; or 367 | 368 | b) Requiring preservation of specified reasonable legal notices or 369 | author attributions in that material or in the Appropriate Legal 370 | Notices displayed by works containing it; or 371 | 372 | c) Prohibiting misrepresentation of the origin of that material, or 373 | requiring that modified versions of such material be marked in 374 | reasonable ways as different from the original version; or 375 | 376 | d) Limiting the use for publicity purposes of names of licensors or 377 | authors of the material; or 378 | 379 | e) Declining to grant rights under trademark law for use of some 380 | trade names, trademarks, or service marks; or 381 | 382 | f) Requiring indemnification of licensors and authors of that 383 | material by anyone who conveys the material (or modified versions of 384 | it) with contractual assumptions of liability to the recipient, for 385 | any liability that these contractual assumptions directly impose on 386 | those licensors and authors. 387 | 388 | All other non-permissive additional terms are considered "further 389 | restrictions" within the meaning of section 10. If the Program as you 390 | received it, or any part of it, contains a notice stating that it is 391 | governed by this License along with a term that is a further 392 | restriction, you may remove that term. If a license document contains 393 | a further restriction but permits relicensing or conveying under this 394 | License, you may add to a covered work material governed by the terms 395 | of that license document, provided that the further restriction does 396 | not survive such relicensing or conveying. 397 | 398 | If you add terms to a covered work in accord with this section, you 399 | must place, in the relevant source files, a statement of the 400 | additional terms that apply to those files, or a notice indicating 401 | where to find the applicable terms. 402 | 403 | Additional terms, permissive or non-permissive, may be stated in the 404 | form of a separately written license, or stated as exceptions; 405 | the above requirements apply either way. 406 | 407 | 8. Termination. 408 | 409 | You may not propagate or modify a covered work except as expressly 410 | provided under this License. Any attempt otherwise to propagate or 411 | modify it is void, and will automatically terminate your rights under 412 | this License (including any patent licenses granted under the third 413 | paragraph of section 11). 414 | 415 | However, if you cease all violation of this License, then your 416 | license from a particular copyright holder is reinstated (a) 417 | provisionally, unless and until the copyright holder explicitly and 418 | finally terminates your license, and (b) permanently, if the copyright 419 | holder fails to notify you of the violation by some reasonable means 420 | prior to 60 days after the cessation. 421 | 422 | Moreover, your license from a particular copyright holder is 423 | reinstated permanently if the copyright holder notifies you of the 424 | violation by some reasonable means, this is the first time you have 425 | received notice of violation of this License (for any work) from that 426 | copyright holder, and you cure the violation prior to 30 days after 427 | your receipt of the notice. 428 | 429 | Termination of your rights under this section does not terminate the 430 | licenses of parties who have received copies or rights from you under 431 | this License. If your rights have been terminated and not permanently 432 | reinstated, you do not qualify to receive new licenses for the same 433 | material under section 10. 434 | 435 | 9. Acceptance Not Required for Having Copies. 436 | 437 | You are not required to accept this License in order to receive or 438 | run a copy of the Program. Ancillary propagation of a covered work 439 | occurring solely as a consequence of using peer-to-peer transmission 440 | to receive a copy likewise does not require acceptance. However, 441 | nothing other than this License grants you permission to propagate or 442 | modify any covered work. These actions infringe copyright if you do 443 | not accept this License. Therefore, by modifying or propagating a 444 | covered work, you indicate your acceptance of this License to do so. 445 | 446 | 10. Automatic Licensing of Downstream Recipients. 447 | 448 | Each time you convey a covered work, the recipient automatically 449 | receives a license from the original licensors, to run, modify and 450 | propagate that work, subject to this License. You are not responsible 451 | for enforcing compliance by third parties with this License. 452 | 453 | An "entity transaction" is a transaction transferring control of an 454 | organization, or substantially all assets of one, or subdividing an 455 | organization, or merging organizations. If propagation of a covered 456 | work results from an entity transaction, each party to that 457 | transaction who receives a copy of the work also receives whatever 458 | licenses to the work the party's predecessor in interest had or could 459 | give under the previous paragraph, plus a right to possession of the 460 | Corresponding Source of the work from the predecessor in interest, if 461 | the predecessor has it or can get it with reasonable efforts. 462 | 463 | You may not impose any further restrictions on the exercise of the 464 | rights granted or affirmed under this License. For example, you may 465 | not impose a license fee, royalty, or other charge for exercise of 466 | rights granted under this License, and you may not initiate litigation 467 | (including a cross-claim or counterclaim in a lawsuit) alleging that 468 | any patent claim is infringed by making, using, selling, offering for 469 | sale, or importing the Program or any portion of it. 470 | 471 | 11. Patents. 472 | 473 | A "contributor" is a copyright holder who authorizes use under this 474 | License of the Program or a work on which the Program is based. The 475 | work thus licensed is called the contributor's "contributor version". 476 | 477 | A contributor's "essential patent claims" are all patent claims 478 | owned or controlled by the contributor, whether already acquired or 479 | hereafter acquired, that would be infringed by some manner, permitted 480 | by this License, of making, using, or selling its contributor version, 481 | but do not include claims that would be infringed only as a 482 | consequence of further modification of the contributor version. For 483 | purposes of this definition, "control" includes the right to grant 484 | patent sublicenses in a manner consistent with the requirements of 485 | this License. 486 | 487 | Each contributor grants you a non-exclusive, worldwide, royalty-free 488 | patent license under the contributor's essential patent claims, to 489 | make, use, sell, offer for sale, import and otherwise run, modify and 490 | propagate the contents of its contributor version. 491 | 492 | In the following three paragraphs, a "patent license" is any express 493 | agreement or commitment, however denominated, not to enforce a patent 494 | (such as an express permission to practice a patent or covenant not to 495 | sue for patent infringement). To "grant" such a patent license to a 496 | party means to make such an agreement or commitment not to enforce a 497 | patent against the party. 498 | 499 | If you convey a covered work, knowingly relying on a patent license, 500 | and the Corresponding Source of the work is not available for anyone 501 | to copy, free of charge and under the terms of this License, through a 502 | publicly available network server or other readily accessible means, 503 | then you must either (1) cause the Corresponding Source to be so 504 | available, or (2) arrange to deprive yourself of the benefit of the 505 | patent license for this particular work, or (3) arrange, in a manner 506 | consistent with the requirements of this License, to extend the patent 507 | license to downstream recipients. "Knowingly relying" means you have 508 | actual knowledge that, but for the patent license, your conveying the 509 | covered work in a country, or your recipient's use of the covered work 510 | in a country, would infringe one or more identifiable patents in that 511 | country that you have reason to believe are valid. 512 | 513 | If, pursuant to or in connection with a single transaction or 514 | arrangement, you convey, or propagate by procuring conveyance of, a 515 | covered work, and grant a patent license to some of the parties 516 | receiving the covered work authorizing them to use, propagate, modify 517 | or convey a specific copy of the covered work, then the patent license 518 | you grant is automatically extended to all recipients of the covered 519 | work and works based on it. 520 | 521 | A patent license is "discriminatory" if it does not include within 522 | the scope of its coverage, prohibits the exercise of, or is 523 | conditioned on the non-exercise of one or more of the rights that are 524 | specifically granted under this License. You may not convey a covered 525 | work if you are a party to an arrangement with a third party that is 526 | in the business of distributing software, under which you make payment 527 | to the third party based on the extent of your activity of conveying 528 | the work, and under which the third party grants, to any of the 529 | parties who would receive the covered work from you, a discriminatory 530 | patent license (a) in connection with copies of the covered work 531 | conveyed by you (or copies made from those copies), or (b) primarily 532 | for and in connection with specific products or compilations that 533 | contain the covered work, unless you entered into that arrangement, 534 | or that patent license was granted, prior to 28 March 2007. 535 | 536 | Nothing in this License shall be construed as excluding or limiting 537 | any implied license or other defenses to infringement that may 538 | otherwise be available to you under applicable patent law. 539 | 540 | 12. No Surrender of Others' Freedom. 541 | 542 | If conditions are imposed on you (whether by court order, agreement or 543 | otherwise) that contradict the conditions of this License, they do not 544 | excuse you from the conditions of this License. If you cannot convey a 545 | covered work so as to satisfy simultaneously your obligations under this 546 | License and any other pertinent obligations, then as a consequence you may 547 | not convey it at all. For example, if you agree to terms that obligate you 548 | to collect a royalty for further conveying from those to whom you convey 549 | the Program, the only way you could satisfy both those terms and this 550 | License would be to refrain entirely from conveying the Program. 551 | 552 | 13. Use with the GNU Affero General Public License. 553 | 554 | Notwithstanding any other provision of this License, you have 555 | permission to link or combine any covered work with a work licensed 556 | under version 3 of the GNU Affero General Public License into a single 557 | combined work, and to convey the resulting work. The terms of this 558 | License will continue to apply to the part which is the covered work, 559 | but the special requirements of the GNU Affero General Public License, 560 | section 13, concerning interaction through a network will apply to the 561 | combination as such. 562 | 563 | 14. Revised Versions of this License. 564 | 565 | The Free Software Foundation may publish revised and/or new versions of 566 | the GNU General Public License from time to time. Such new versions will 567 | be similar in spirit to the present version, but may differ in detail to 568 | address new problems or concerns. 569 | 570 | Each version is given a distinguishing version number. If the 571 | Program specifies that a certain numbered version of the GNU General 572 | Public License "or any later version" applies to it, you have the 573 | option of following the terms and conditions either of that numbered 574 | version or of any later version published by the Free Software 575 | Foundation. If the Program does not specify a version number of the 576 | GNU General Public License, you may choose any version ever published 577 | by the Free Software Foundation. 578 | 579 | If the Program specifies that a proxy can decide which future 580 | versions of the GNU General Public License can be used, that proxy's 581 | public statement of acceptance of a version permanently authorizes you 582 | to choose that version for the Program. 583 | 584 | Later license versions may give you additional or different 585 | permissions. However, no additional obligations are imposed on any 586 | author or copyright holder as a result of your choosing to follow a 587 | later version. 588 | 589 | 15. Disclaimer of Warranty. 590 | 591 | THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY 592 | APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT 593 | HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY 594 | OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, 595 | THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 596 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM 597 | IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF 598 | ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 599 | 600 | 16. Limitation of Liability. 601 | 602 | IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 603 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS 604 | THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY 605 | GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE 606 | USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF 607 | DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD 608 | PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), 609 | EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF 610 | SUCH DAMAGES. 611 | 612 | 17. Interpretation of Sections 15 and 16. 613 | 614 | If the disclaimer of warranty and limitation of liability provided 615 | above cannot be given local legal effect according to their terms, 616 | reviewing courts shall apply local law that most closely approximates 617 | an absolute waiver of all civil liability in connection with the 618 | Program, unless a warranty or assumption of liability accompanies a 619 | copy of the Program in return for a fee. 620 | 621 | END OF TERMS AND CONDITIONS 622 | 623 | How to Apply These Terms to Your New Programs 624 | 625 | If you develop a new program, and you want it to be of the greatest 626 | possible use to the public, the best way to achieve this is to make it 627 | free software which everyone can redistribute and change under these terms. 628 | 629 | To do so, attach the following notices to the program. It is safest 630 | to attach them to the start of each source file to most effectively 631 | state the exclusion of warranty; and each file should have at least 632 | the "copyright" line and a pointer to where the full notice is found. 633 | 634 | 635 | Copyright (C) 636 | 637 | This program is free software: you can redistribute it and/or modify 638 | it under the terms of the GNU General Public License as published by 639 | the Free Software Foundation, either version 3 of the License, or 640 | (at your option) any later version. 641 | 642 | This program is distributed in the hope that it will be useful, 643 | but WITHOUT ANY WARRANTY; without even the implied warranty of 644 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 645 | GNU General Public License for more details. 646 | 647 | You should have received a copy of the GNU General Public License 648 | along with this program. If not, see . 649 | 650 | Also add information on how to contact you by electronic and paper mail. 651 | 652 | If the program does terminal interaction, make it output a short 653 | notice like this when it starts in an interactive mode: 654 | 655 | Copyright (C) 656 | This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 657 | This is free software, and you are welcome to redistribute it 658 | under certain conditions; type `show c' for details. 659 | 660 | The hypothetical commands `show w' and `show c' should show the appropriate 661 | parts of the General Public License. Of course, your program's commands 662 | might be different; for a GUI interface, you would use an "about box". 663 | 664 | You should also get your employer (if you work as a programmer) or school, 665 | if any, to sign a "copyright disclaimer" for the program, if necessary. 666 | For more information on this, and how to apply and follow the GNU GPL, see 667 | . 668 | 669 | The GNU General Public License does not permit incorporating your program 670 | into proprietary programs. If your program is a subroutine library, you 671 | may consider it more useful to permit linking proprietary applications with 672 | the library. If this is what you want to do, use the GNU Lesser General 673 | Public License instead of this License. But first, please read 674 | . 675 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Normalization by Evaluation, for combinators 2 | 3 | - `combinator.agda` defines the basic concepts. We work in a language 4 | with the combinators `𝕂` `𝕊`, and the natural numbers `O` `S`, together 5 | with a recursion combinator `ℝ`. 6 | - `reduce.agda` describes how to reduce combinators with reductions, 7 | basically a big-step semantics. Note that we have to add the Agda pragma 8 | `{-# TERMINATING #-}`, because it's not obvious that such a reduction 9 | terminates. 10 | - `nbe.agda` uses normalization by evaluation. Apart from being slightly faster 11 | (I cannot measure accurately, but it seems to be around 2x faster), it also 12 | convinces Agda that the process terminates. 13 | 14 | - `nbe.py` gives a quick implementation in python, stripped of all the 15 | proofs. It is basically just 10 lines! 16 | 17 | # Normalization by Evaluation, for simply typed lambda calculus 18 | 19 | I eventually got around to implement NbE for STLC. Please note that 20 | since I'm working on a case-insensitive filesystem, you might need to 21 | adjust the file cases according to this Readme. 22 | 23 | - `Equivalence.agda` defines handy tools. 24 | - `STLC.agda` defines simply typed lambda calculus, demonstrates how to 25 | translate it into combinators, and defines relevant basic concepts. 26 | - `Substitution.agda` proves various substitution lemmas. 27 | - `NbE.agda` implements normalization by evaluation. 28 | - `Category.agda` packs up everything we proved in previous files step by 29 | step into a neat, categorical language, as described in Chapter 4, Sections 1-2 30 | of Jonathan Sterling's thesis *First Steps in Synthetic Tait Computability*. 31 | 32 | -------- 33 | 34 | The files have plenty of comments, and are intended to be read in 35 | the order as listed. 36 | -------------------------------------------------------------------------------- /STLC/Category.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --prop --postfix-projections --safe #-} 2 | module STLC.Category where 3 | open import Data.Sum using (_⊎_; inj₁; inj₂) 4 | open import Data.Product using (Σ; _,_) 5 | open import Agda.Builtin.Equality using (_≡_; refl) 6 | 7 | open import STLC.Equivalence 8 | open import STLC.STLC 9 | open import STLC.Substitution 10 | 11 | private variable 12 | α β γ : Type 13 | Γ Γ₁ Γ₂ Δ Δ₁ Δ₂ Ξ : Context 14 | σ τ σ₁ σ₂ σ₃ : Substitution Γ Δ 15 | ρ ρ₀ ρ₁ ρ₂ ρ₃ : Renaming Γ Δ 16 | 17 | -- The following material packages everything up into nice categorical language. 18 | -- I'm not going through the work of proving trivial lemmas. The key lemmas are 19 | -- already proved in our previous work, and I'll restate them in a better form. 20 | module 𝓣 where 21 | Obj : Set 22 | Obj = Context 23 | 24 | Mor : Obj -> Obj -> Set 25 | Mor Γ Δ = {α : Type} -> Var Δ α -> Term Γ α 26 | -- Why the reversal? Fundamentally, it's because this suggests 27 | -- Mor Γ Δ ∼ Γ ⊢ Δ 28 | -- i.e. a list of judgements Γ ⊢ x : α. This order makes concepts 29 | -- like products and sums much more natural. 30 | 31 | idMor : Mor Γ Γ 32 | idMor = var 33 | 34 | compMor : Mor Γ Δ -> Mor Ξ Γ -> Mor Ξ Δ 35 | compMor σ τ = sub τ ∘ σ 36 | 37 | -- To prevent Agda inserting implicit arguments. 38 | -- Also to avoid function extensionality. 39 | _==_ : Mor Γ Δ -> Mor Γ Δ -> Prop 40 | σ == τ = ∀ {α} {v : Var _ α} -> σ v ≈ τ v 41 | infix 3 _==_ 42 | 43 | -- The following laws are either trivial or proved in STLC.Substitution. 44 | idₗ : compMor idMor σ == σ 45 | idₗ = refl 46 | 47 | idᵣ : compMor σ idMor == σ 48 | idᵣ {σ = σ} {v = v} rewrite sub-var (σ v) = refl 49 | 50 | assoc : compMor (compMor σ₁ σ₂) σ₃ == compMor σ₁ (compMor σ₂ σ₃) 51 | assoc {σ₁ = σ₁} {σ₂ = σ₂} {σ₃ = σ₃} {v = v} 52 | rewrite sub-sub σ₃ σ₂ (σ₁ v) = refl 53 | 54 | -- Our category has products: context concatenation. 55 | _×_ : Obj -> Obj -> Obj 56 | Γ × ∅ = Γ 57 | Γ × (Δ ◂ α) = (Γ ◂ α) × Δ 58 | infixl 20 _×_ 59 | 60 | private 61 | p₁ : Renaming Γ (Γ × Δ) 62 | p₁ {Δ = ∅} v = v 63 | p₁ {Δ = Δ ◂ _} v = p₁ {Δ = Δ} (𝕤 v) 64 | 65 | p₂ : Renaming Δ (Γ × Δ) 66 | p₂ {Δ = Δ ◂ _} 𝕫 = p₁ {Δ = Δ} 𝕫 67 | p₂ {Δ = Δ ◂ _} (𝕤 v) = p₂ v 68 | 69 | split : Var (Γ × Δ) α -> Var Γ α ⊎ Var Δ α 70 | split {Δ = ∅} v = inj₁ v 71 | split {Δ = Δ ◂ _} v with split {Δ = Δ} v 72 | ... | inj₁ 𝕫 = inj₂ 𝕫 73 | ... | inj₁ (𝕤 v) = inj₁ v 74 | ... | inj₂ v = inj₂ (𝕤 v) 75 | 76 | π₁ : Mor (Γ × Δ) Γ 77 | π₁ {Δ = Δ} x = var (p₁ {Δ = Δ} x) 78 | 79 | π₂ : Mor (Γ × Δ) Δ 80 | π₂ v = var (p₂ v) 81 | 82 | ⟨_×_⟩ : Mor Ξ Γ -> Mor Ξ Δ -> Mor Ξ (Γ × Δ) 83 | ⟨_×_⟩ {Δ = Δ} σ τ v with split {Δ = Δ} v 84 | ... | inj₁ v = σ v 85 | ... | inj₂ v = τ v 86 | -- The laws of products are omitted. But the reader should see that there 87 | -- is no difficulty proving them. 88 | 89 | 𝟏 : Obj 90 | 𝟏 = ∅ 91 | 92 | -- Exponential objects are expressed using function spaces. But since we 93 | -- need to deal with exponential objects between contexts, we need a 94 | -- telescoping operation: 95 | Telescope : Context -> Type -> Type 96 | Telescope ∅ α = α 97 | Telescope (Γ ◂ β) α = β ⇒ Telescope Γ α 98 | 99 | private 100 | abs : Term (Δ × Γ) α -> Term Δ (Telescope Γ α) 101 | abs {Γ = ∅} t = t 102 | abs {Γ = Γ ◂ _} t = ^ abs t 103 | 104 | app : Term Δ (Telescope Γ α) -> Term (Δ × Γ) α 105 | app {Γ = ∅} t = t 106 | app {Γ = Γ ◂ _} t = app {Γ = Γ} (ren 𝕤_ t ∙ var 𝕫) 107 | 108 | Hom : Obj -> Obj -> Obj 109 | Hom Γ ∅ = ∅ 110 | Hom Γ (Δ ◂ α) = Hom Γ Δ ◂ Telescope Γ α 111 | 112 | -- And the usual adjunction properties for exponential objects. 113 | -- Keep in mind that Hom here denotes internal hom, while Mor is the arrows. 114 | uncurry : Mor Γ (Hom Ξ Δ) -> Mor (Γ × Ξ) Δ 115 | uncurry σ 𝕫 = app (σ 𝕫) 116 | uncurry σ (𝕤 v) = uncurry (σ ∘ 𝕤_) v 117 | 118 | curry : Mor (Γ × Ξ) Δ -> Mor Γ (Hom Ξ Δ) 119 | curry {Δ = Δ ◂ _} σ 𝕫 = abs (σ 𝕫) 120 | curry {Δ = Δ ◂ _} σ (𝕤 v) = curry (σ ∘ 𝕤_) v 121 | -- As usual we omit the laws. Note that the two adjunction laws require 122 | -- β- and η-conversions, respectively. 123 | 124 | -- Apart from substitutions, we also have a category of renamings, 125 | -- which will prove useful later on. Renamings are basically permutations 126 | -- that preserves types, so it is easy refls. 127 | module 𝓦 where 128 | Obj : Set 129 | Obj = Context 130 | 131 | Mor : Obj -> Obj -> Set 132 | Mor Γ Δ = {α : Type} -> Var Δ α -> Var Γ α 133 | 134 | idMor : Mor Γ Γ 135 | idMor = id 136 | 137 | compMor : Mor Γ Δ -> Mor Ξ Γ -> Mor Ξ Δ 138 | compMor ρ₁ ρ₂ = ρ₂ ∘ ρ₁ 139 | 140 | _==_ : Mor Γ Δ -> Mor Γ Δ -> Set 141 | ρ₁ == ρ₂ = ∀ {α} {v : Var _ α} -> ρ₁ v ≡ ρ₂ v 142 | infix 3 _==_ 143 | 144 | idₗ : compMor idMor ρ == ρ 145 | idₗ = refl 146 | 147 | idᵣ : compMor ρ idMor == ρ 148 | idᵣ = refl 149 | 150 | assoc : compMor (compMor ρ₁ ρ₂) ρ₃ == compMor ρ₁ (compMor ρ₂ ρ₃) 151 | assoc = refl 152 | 153 | -- We define the Shape functor ∫. This determines the shape of the Kripke 154 | -- worlds. It is denoted by ρ in J.Sterling's thesis. 155 | module Shape where 156 | ∫ : 𝓦.Obj -> 𝓣.Obj 157 | ∫ = id -- The map on objects is identity. 158 | 159 | fmap : 𝓦.Mor Γ Δ -> 𝓣.Mor (∫ Γ) (∫ Δ) 160 | fmap ρ = ren ρ ∘ var 161 | 162 | fmap-id : let _==_ = 𝓣._==_ in 163 | fmap {Γ} 𝓦.idMor == 𝓣.idMor 164 | fmap-id = refl 165 | 166 | fmap-comp : let _==_ = 𝓣._==_ in 167 | fmap (𝓦.compMor ρ₁ ρ₂) == 𝓣.compMor (fmap ρ₁) (fmap ρ₂) 168 | fmap-comp = refl 169 | open Shape using (∫) 170 | 171 | -- Since I'm not gonna prove all the laws, we just need this poor man's presheaf 172 | -- definition :P 173 | Psh : Set -> Set₁ 174 | Psh X = X -> Set 175 | 176 | PshMor : (X : Set) -> Psh X -> Psh X -> Set 177 | PshMor X 𝔞 𝔟 = ∀ {A} -> 𝔞 A -> 𝔟 A 178 | 179 | -- Ignore this if you don't already know simplicial sets. It only explains 180 | -- the origin of the name "Nerve". 181 | 182 | -- In simplicial homotopy, the Nerve functor maps a category to a simplicial 183 | -- set having the same "shape". An object to a vertex, a morphism to an edge, 184 | -- a commutative triangle to a trangle face, etc. So, mapping a category 𝒞 to 185 | -- a simplicial set (i.e. a function f : Δᵒᵖ -> Set), the nerve functor is 186 | -- (N : Cat -> Psh(Δ)). We have that N(A)ₙ, the n-face component, is the hom-set 187 | -- Mor(Δₙ , 𝒞), where Δₙ is a category with (n+1) objects A₀->A₁->...->Aₙ. 188 | 189 | -- This can be generalized to any (N : 𝒞 -> Psh(Δ)), as long as we have an 190 | -- "internal Δₙ" in 𝒞, i.e. we need a functor (ρ : ℕ -> 𝒞), and we define 191 | -- N(A)ₙ = Mor(ρ(n), A). This ρ is called the "shape". Of course, we need not 192 | -- be confined to ℕ. So with any "shape" functor (ρ : 𝒲 -> 𝒞), we can form 193 | -- N(A)(i) = Mor(ρ(i), A). This makes N a functor from 𝒞 to Psh(𝒲). 194 | 195 | -- The Nerve functor, which we denote as Pts, computes a presheaf of Kripke 196 | -- structures. It's fine if you don't see how. Since we've defined Red in our 197 | -- previous work, which was said to possess a Kripke structure, we will later 198 | -- relate Pts to Red. 199 | module Nerve where 200 | Pts : 𝓣.Obj -> Psh 𝓦.Obj 201 | Pts Γ = \ Δ -> 𝓣.Mor (∫ Δ) Γ 202 | 203 | -- Pts Γ is indeed a presheaf for each Γ: 204 | psh-fmap : 𝓦.Mor Δ₁ Δ₂ -> (Pts Γ Δ₂ -> Pts Γ Δ₁) 205 | psh-fmap ρ σ = ren ρ ∘ σ 206 | 207 | -- And Pts is indded a functor from 𝓣 to Psh(𝓦): 208 | fmap : 𝓣.Mor Γ₁ Γ₂ -> PshMor 𝓦.Obj (Pts Γ₁) (Pts Γ₂) 209 | fmap σ₁ σ₂ = sub σ₂ ∘ σ₁ 210 | -- Laws omitted 211 | open Nerve using (Pts) 212 | -- The types may be a little bit confusing, but this is basically because I'm 213 | -- too lazy to set up all the category structures. If we rewrite this with a 214 | -- proper category theory library, Agda will force us to prove all the laws, 215 | -- which probably makes it clearer. 216 | 217 | module Glue where 218 | -- The type of computability structures: 219 | record Tait (Γ : 𝓣.Obj) : Set₁ where 220 | field 221 | -- Tait structures on Γ are defined as: 222 | -- Total : Psh 𝓦.Obj 223 | -- proj : ∀ {Δ} -> Total Δ -> Pts Γ Δ 224 | -- Presheaf morphism laws of proj omitted. 225 | -- We can do that, but note that whenever we have a structure 226 | -- consisting of a (T : Set) and (proj : T -> X), we can always 227 | -- rewrite it as (fiber : X -> Set) and let T be (Σ X fiber). 228 | -- This suggests we can do the same to presheafs. 229 | fiber : ∀ {Δ} -> Pts Γ Δ -> Set 230 | private 231 | Total : Psh 𝓦.Obj 232 | Total Δ = Σ (Pts Γ Δ) fiber 233 | -- The definition with Total is more suited to the category language 234 | -- using slice categories, while we can use the fiber definition 235 | -- which is more convenient in type theory. 236 | -- We need to remember that we need the functor law for proj, i.e. 237 | -- for any (ρ : 𝓦.Mor Δ₁ Δ₂), we need to prove that Total gives a fmap 238 | -- to (fmap ρ : Total Δ₂ -> Total Δ₁), and we need to natural transform 239 | -- that with proj to Pts Γ. Unpacking this to the fiber language, we 240 | -- arrive at: 241 | field 242 | fiber-fmap : (ρ : 𝓦.Mor Δ₁ Δ₂) (pt : Pts Γ Δ₂) 243 | -> (fiber pt -> fiber (Nerve.psh-fmap ρ pt)) 244 | -- Laws are also omitted. 245 | -- If you unfold this, you can see that this amounts to giving 246 | -- (fiber pt -> fiber (ren ρ ∘ pt)). 247 | -- This is just our Red-ren : Red t -> Red (ren ρ t) 248 | -- but with Red generalized to operate on contexts. 249 | 250 | -- The objects of the glued category 𝓖 is just (Σ 𝓣.Obj Tait). 251 | -- This creates a natural projection proj₁ : 𝓖.Obj -> 𝓣.Obj. 252 | open Tait 253 | 254 | -- The fundamental theorem we want to prove is that there is 255 | -- a section of proj₁, i.e. a map sect : (Γ : 𝓣.Obj) -> Tait Γ. 256 | 257 | -- We import our Red definition, and generalize it to contexts. 258 | open import STLC.NbE 259 | Reds : (Γ Δ : Context) -> Pts Γ Δ -> Set 260 | Reds Γ Δ σ = ∀ {α} -> (v : Var Γ α) -> Red (σ v) 261 | 262 | sect : (Γ : 𝓣.Obj) -> Tait Γ 263 | sect _ .fiber = Reds _ _ 264 | -- Yay, we're done! ... wait, is it that simple? Of course not. 265 | -- We need to prove that the whole thing satisfies laws. 266 | 267 | sect _ .fiber-fmap ρ₀ pt Rs = Reds-ren Rs 268 | where 269 | Reds-ren : Reds Γ Δ₂ σ -> Reds Γ Δ₁ (ren ρ ∘ σ) 270 | Reds-ren Rs v = Red-ren _ (Rs v) 271 | -- Since we've already done all the hard work, this just generalizes to 272 | -- a list of terms (a.k.a. a substitution) instead of just a term. 273 | 274 | -- And finally, we need the *ultimate* proof: sect must be natural, which 275 | -- we omitted in the Tait record. 276 | 277 | -- Natural in what category? Recall that sect is a right inverse to 278 | -- proj, which is a morphism from (Total : Psh(𝓦)) to (Pts Γ : Psh(𝓦)), 279 | -- and morphisms from presheafs to presheafs are natural transformations. 280 | -- Translating to the fibered language, we have 281 | sect-natural : (σ : 𝓣.Mor Γ₁ Γ₂) (pt : Pts Γ₁ Δ) 282 | -> Reds Γ₁ Δ pt -> Reds Γ₂ Δ (𝓣.compMor σ pt) 283 | -- How do we prove that, welllll... 284 | -- Look back at the definition of Reds. Don't you think "Red generalized 285 | -- to substitutions" sounds familiar? This is because it is exactly our 286 | -- SubstRed! 287 | _ : Reds Γ Δ σ ≡ SubstRed σ 288 | _ = refl 289 | 290 | sect-natural σ pt Rs v = ⟦ σ v ⟧ Rs 291 | -- Violà! We successfully packaged every result we proved up into a better, 292 | -- more categorical language! 293 | 294 | -- For "purely categorical" versions, read Chapter 4 of Sterling's thesis. 295 | -------------------------------------------------------------------------------- /STLC/Equivalence.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --prop --safe #-} 2 | module STLC.Equivalence where 3 | open import Agda.Primitive 4 | open import Agda.Builtin.Equality 5 | open import Function.Base using (_$_; _∘_; id; _∋_) public 6 | open import Data.Empty using (⊥) public 7 | 8 | private variable 9 | ℓ ℓ' : Level 10 | A B C : Set ℓ 11 | P Q R : Prop ℓ 12 | 13 | infixl 10 _⊚_ 14 | _⊚_ : -- The _∘_ from stdlib doesn't work on Props 15 | (P -> Q) -> (R -> P) -> (R -> Q) 16 | (f ⊚ g) z = f (g z) 17 | {-# INLINE _⊚_ #-} 18 | 19 | -- We develop the theory of equivalence closures once and for all. 20 | data Equivalence {A : Set ℓ} (_~_ : A -> A -> Prop ℓ') : A -> A -> Prop (ℓ ⊔ ℓ') where 21 | refl : ∀ {a} -> Equivalence _~_ a a 22 | step : ∀ {a b c} -> a ~ b -> Equivalence _~_ b c -> Equivalence _~_ a c 23 | back : ∀ {a b c} -> b ~ a -> Equivalence _~_ b c -> Equivalence _~_ a c 24 | 25 | pattern single r = step r refl 26 | pattern _⟶_ r R = step r R 27 | pattern _⟵_ r R = back r R 28 | infixr 3 _⟶_ _⟵_ 29 | 30 | private variable 31 | a b c : A 32 | _~_ _-_ : A -> A -> Prop ℓ 33 | 34 | -- Concatenation: 35 | _⁀_ : Equivalence _~_ a b -> Equivalence _~_ b c -> Equivalence _~_ a c 36 | refl ⁀ R' = R' 37 | step r R ⁀ R' = step r (R ⁀ R') 38 | back r R ⁀ R' = back r (R ⁀ R') 39 | infixl 5 _⁀_ 40 | 41 | -- Reversal: 42 | _⁻¹ : Equivalence _~_ a b -> Equivalence _~_ b a 43 | R ⁻¹ = helper refl R 44 | where 45 | helper : Equivalence _~_ b a 46 | -> Equivalence _~_ b c 47 | -> Equivalence _~_ c a 48 | helper R refl = R 49 | helper R (step r R') = helper (back r R) R' 50 | helper R (back r R') = helper (step r R) R' 51 | infixl 20 _⁻¹ 52 | 53 | -- Maps 54 | map : {f : A -> B} (F : ∀ {a b} -> a ~ b -> f a - f b) 55 | -> Equivalence _~_ a b -> Equivalence _-_ (f a) (f b) 56 | map F refl = refl 57 | map F (step r R) = step (F r) (map F R) 58 | map F (back r R) = back (F r) (map F R) 59 | 60 | record Subset (A : Set ℓ) (B : A -> Prop ℓ') : Set (ℓ ⊔ ℓ') where 61 | constructor ι 62 | field 63 | object : A 64 | witness : B object 65 | syntax Subset A (λ a -> B) = [ a ∈ A ∣ B ] 66 | 67 | data _∧_ (A : Prop ℓ) (B : Prop ℓ') : Prop (ℓ ⊔ ℓ') where 68 | ⟨_,_⟩ : A -> B -> A ∧ B 69 | infixl 3 _∧_ 70 | -------------------------------------------------------------------------------- /STLC/nbe.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --prop --postfix-projections --safe #-} 2 | module STLC.NbE where 3 | open import Agda.Builtin.Nat 4 | 5 | open import STLC.Equivalence 6 | open import STLC.STLC 7 | open import STLC.Substitution 8 | 9 | open import Relation.Binary.PropositionalEquality 10 | open ≡-Reasoning 11 | open import Tactic.Cong 12 | 13 | open WN using (nf; NF; Conv) 14 | 15 | private variable 16 | α β γ : Type 17 | Γ Δ : Context 18 | t s : Term Γ α 19 | 20 | -- Similar to our combinators, we define a reducible predicate. 21 | -- Unlike combinators which has no contexts, we introduce an 22 | -- additional Renaming argument in the function space. 23 | -- This is because when reifying, when we encounter a λ, we need 24 | -- to snuck in a fresh variable. The Renaming gives us the elbow- 25 | -- room to do this. (Exercise: Try defining Red without the 26 | -- Renaming, and describe the difficulties you meet.) 27 | -- This is in the spirit of Kripke-models, where we have many "worlds" 28 | -- with an accessibility relation (w ≫ w'). A proposition is interpreted 29 | -- at a specific world (w ⊢ p). The intuitionistic implication 30 | -- (w ⊢ p → q) is interpreted as 31 | -- ∀ w' -> w ≫ w' -> w' ⊢ p → q 32 | -- This makes the model much more suitable for proving metatheorems. 33 | Red : Term Γ α -> Set 34 | Red {α = ℕ} t = WN t 35 | Red {α = α ⇒ β} t = ∀ {Δ} (ρ : Renaming _ Δ) -> 36 | ∀ {s} -> Red s -> Red (ren ρ t ∙ s) 37 | 38 | -- We now extend some colloraries of renaming concerning reductions. 39 | module _ where 40 | -- Special status is given to renaming, because it has the good property 41 | -- that renaming turns normal forms into normal forms. 42 | Neutral-ren : (ρ : Renaming Γ Δ) -> Neutral t -> Neutral (ren ρ t) 43 | Normal-ren : (ρ : Renaming Γ Δ) -> Normal t -> Normal (ren ρ t) 44 | Neutral-ren ρ (var v) = var (ρ v) 45 | Neutral-ren ρ (ν ∙ ν') = Neutral-ren ρ ν ∙ Normal-ren ρ ν' 46 | Neutral-ren ρ (Rec ν₁ ν₂ ν₃) 47 | = Rec (Normal-ren ρ ν₁) (Normal-ren ρ ν₂) (Neutral-ren ρ ν₃) 48 | Normal-ren ρ (ntr ν) = ntr (Neutral-ren ρ ν) 49 | Normal-ren ρ (^ ν) = ^ Normal-ren (wren ρ ◃ᵣ 𝕫) ν 50 | Normal-ren ρ O = O 51 | Normal-ren ρ (S ν) = S (Normal-ren ρ ν) 52 | 53 | -- Renaming also preserves reduction. 54 | ~>-ren : (ρ : Renaming Γ Δ) -> s ~> t -> ren ρ s ~> ren ρ t 55 | ~>-ren ρ (red (β! {t = t} {s = s})) = R 56 | where 57 | eq : _ 58 | eq = 59 | begin 60 | ren ρ (sub (𝕫:= s) t) 61 | ≡⟨ ren-sub _ _ t ⟩ 62 | sub (ren ρ ∘ (𝕫:= s)) t 63 | ≡˘⟨ subᵉ (ren-𝕫:= ρ s) t ⟩ 64 | sub ((var ◃ₛ ren ρ s) ∘ (wren ρ ◃ᵣ 𝕫)) t 65 | ≡˘⟨ sub-ren _ _ t ⟩ 66 | sub (𝕫:= ren ρ s) (ren (wren ρ ◃ᵣ 𝕫) t) 67 | ∎ 68 | 69 | R : ren ρ ((^ t) ∙ s) ~> ren ρ (sub (𝕫:= s) t) 70 | R rewrite eq = red β! 71 | 72 | ~>-ren {s = s} ρ (red (η! {α = α})) = R 73 | where 74 | eq : _ 75 | eq = 76 | begin 77 | ren (wren ρ ◃ᵣ 𝕫) (ren 𝕤_ s) 78 | ≡⟨ ren-ren _ _ s ⟩ 79 | ren (𝕤_ ∘ ρ) s 80 | ≡˘⟨ ren-ren _ _ s ⟩ 81 | ren (𝕤_ {β = α}) (ren ρ s) 82 | ∎ 83 | 84 | R : ren ρ s ~> ^ ren (wren ρ ◃ᵣ 𝕫) (ren 𝕤_ s) ∙ var 𝕫 85 | R rewrite eq = red η! 86 | 87 | -- These two are much easier because no binding is involved. 88 | ~>-ren ρ (red ιₒ!) = red ιₒ! 89 | ~>-ren ρ (red ιₛ!) = red ιₛ! 90 | 91 | -- These are just congruence closures. 92 | ~>-ren ρ (^ r) = ^ ~>-ren (wren ρ ◃ᵣ 𝕫) r 93 | ~>-ren ρ (r ~∙ _) = ~>-ren ρ r ~∙ _ 94 | ~>-ren ρ (_ ∙~ r) = _ ∙~ ~>-ren ρ r 95 | 96 | WN-ren : (ρ : Renaming Γ Δ) -> WN t -> WN (ren ρ t) 97 | WN-ren ρ (wn ν R) = wn (Normal-ren ρ ν) (map (~>-ren ρ) R) 98 | 99 | Red-ren : (ρ : Renaming Γ Δ) {t : Term Γ α} -> Red t -> Red (ren ρ t) 100 | Red-ren {α = ℕ} ρ F = WN-ren ρ F 101 | Red-ren {α = α ⇒ β} ρ {t = t} F ρ' {s = s} G 102 | rewrite ren-ren ρ' ρ t = F (ρ' ∘ ρ) G 103 | 104 | -- Similar to the combinator case, Reducibility is preserved 105 | -- by reductions. 106 | Red-≈ : {s t : Term Γ α} -> s ≈ t -> Red s -> Red t 107 | Red-≈ {α = ℕ} R (wn ν R') = wn ν (R ⁻¹ ⁀ R') 108 | Red-≈ {α = α ⇒ β} R F ρ G = Red-≈ (map (_~∙ _ ⊚ ~>-ren ρ) R) (F ρ G) 109 | 110 | -- Now we have set up everything needed. Let's look at the big picture. 111 | 112 | -- We assigned "meaning" to our terms with Red. 113 | 114 | -- ⟦_⟧======> Red <-----reflect 115 | -- || | | 116 | -- || reify | 117 | -- || | | 118 | -- || ↓ | 119 | -- Term ⊇ Normal‡ ⊇ Neutral ⊇ Var 120 | 121 | -- ‡ Actually we use WN instead of Normal, to keep track of 122 | -- the normalization path. So you may regard this as an extra middle layer. 123 | 124 | -- We first define a reify function to extract the normal form 125 | -- from the Red semantics. But during this stage, when dealing with 126 | -- terms of type (α ⇒ β), we have (Red t) which takes any reducible 127 | -- (Red s) to (Red (t ∙ s)) modulo a renaming. So we should apply 128 | -- (Red (var 𝕫)) to get (Red (t ∙ var 𝕫)), and then we can happily 129 | -- abstract the normal form with a λ. However, the term t is in context 130 | -- Γ, while we need to lift it to (Γ ◂ α) so that (var 𝕫) is a valid 131 | -- term. This is how the "elbow-room" we previously left helps. 132 | 133 | -- Also, although it may seem trivial to just apply (var 𝕫), it is not 134 | -- immediate that we have (Red (var 𝕫)) because (var 𝕫) is not 135 | -- necessarily normal! We might have to η-expand it. This gives rise 136 | -- to another function called "reflect", which is weaker because 137 | -- it only needs to deal with Neutral terms. 138 | -- (You might be tempted to say that you only need to deal with Var, 139 | -- which is even simpler. But unfortunately after an η-expansion, 140 | -- you will have to deal with function applications.) 141 | 142 | reify : {t : Term Γ α} -> Red t -> WN t 143 | reflect : {t : Term Γ α} -> Neutral t -> Red t 144 | 145 | reify {α = ℕ} F = F 146 | reify {α = α ⇒ β} F with reify $ F 𝕤_ $ reflect (var 𝕫) 147 | ... | wn ν R = wn (^ ν) (single (red η!) ⁀ map ^_ R) 148 | -- If you get rid of the theorem proving part, it simply 149 | -- turns (wn ν _) into (wn (^ ν) _). Here (wn ν _) comes 150 | -- from applying (var 𝕫) to F, with the lifting 𝕤_. 151 | 152 | reflect {α = ℕ} ν = normal (ntr ν) 153 | reflect {α = α ⇒ β} ν ρ F with reify F 154 | ... | wn ν' R' = Red-≈ (map (_ ∙~_) (R' ⁻¹)) $ 155 | reflect $ Neutral-ren ρ ν ∙ ν' 156 | 157 | -- To make the induction go through, we have to additionally carry 158 | -- a substitution around. This substitution acts as the "environment" 159 | -- during the reduction. In other words, when we are reducing an 160 | -- application (λ x . t) s, we add (x <- s) to the environment, and go 161 | -- inside t to continue reducing. 162 | 163 | -- For this purpose, we need a Red predicate on substitutions. 164 | SubstRed : Substitution Γ Δ -> Set 165 | SubstRed σ = ∀ {α} (v : Var _ α) -> Red (σ v) 166 | 167 | -- To start a reduction, we supply the identity environment. 168 | Red-id : SubstRed {Γ = Γ} var 169 | Red-id v = reflect (var v) 170 | 171 | -- Now the final induction. 172 | ⟦_⟧ : ∀ (t : Term Γ α) {Δ} {σ : Substitution Γ Δ} 173 | -> SubstRed σ -> Red (sub σ t) 174 | ⟦ t ∙ s ⟧ σ = subst (λ ⋆ -> Red (⋆ ∙ _)) (ren-id _) $ 175 | (⟦ t ⟧ σ) id (⟦ s ⟧ σ) 176 | ⟦ var v ⟧ σ = σ v 177 | ⟦ O ⟧ σ = normal O 178 | ⟦ S ⟧ σ ρ (wn ν R) = wn (S ν) (map (_ ∙~_) R) 179 | ⟦ Rec ⟧ σ ρ₁ {s₁} F₁ ρ₂ {s₂} F₂ ρ₃ {s₃} w₃@(wn ν R) 180 | with reify F₁ | reify {t = s₂} F₂ 181 | -- Agda inserts implicit arguments too early, so I have to mark this. 182 | ... | w₁@(wn ν₁ R₁) | w₂@(wn ν₂ R₂) = ⟦Rec⟧ ν R 183 | where 184 | ⟦Rec⟧ : {s s' : Term _ ℕ} (ν : Normal s') (R : s ≈ s') 185 | -> Red (Rec ∙ ren ρ₃ (ren ρ₂ s₁) ∙ ren ρ₃ s₂ ∙ s) 186 | ⟦Rec⟧ (ntr ν) R = Red-≈ -- We first reduce the corresponding components. 187 | -- Then we piece the reductions together. 188 | ( map (_~∙ _ ⊚ _~∙ _ ⊚ _ ∙~_ ⊚ ~>-ren ρ₃ ⊚ ~>-ren ρ₂) (R₁ ⁻¹) 189 | ⁀ map (_~∙ _ ⊚ _ ∙~_ ⊚ ~>-ren ρ₃) (R₂ ⁻¹) 190 | ⁀ map (_ ∙~_) (R ⁻¹)) $ reflect $ -- And use reflect on the final neutral form. 191 | Rec (Normal-ren ρ₃ (Normal-ren ρ₂ ν₁)) (Normal-ren ρ₃ ν₂) ν 192 | ⟦Rec⟧ {s' = (S ∙ s₀)} (S ν) R = Red-≈ (red ιₛ! ⟵ map (_ ∙~_) (R ⁻¹)) ⟦Rec⟧S 193 | where 194 | eq : (Term _ _ ∋ ren ρ₃ s₂ ∙ s₀) ≡ ren id (ren ρ₃ s₂) ∙ ren id s₀ 195 | eq rewrite ren-id s₀ | ren-id (ren ρ₃ s₂) = refl 196 | 197 | ⟦Rec⟧S : Red (ren ρ₃ s₂ ∙ s₀ ∙ 198 | (Rec ∙ ren ρ₃ (ren ρ₂ s₁) ∙ ren ρ₃ s₂ ∙ s₀)) 199 | ⟦Rec⟧S rewrite eq = F₂ ρ₃ (wn ν refl) id (⟦Rec⟧ ν refl) 200 | 201 | ⟦Rec⟧ O R = Red-≈ (red ιₒ! ⟵ map (_ ∙~_) (R ⁻¹)) 202 | (Red-ren ρ₃ (Red-ren ρ₂ F₁)) 203 | 204 | ⟦ ^ t ⟧ {σ = σ₀} σ ρ {s = s} F = Red-≈ (red β! ⟵ refl) G 205 | where 206 | eqᵉ : (v : Var _ α) 207 | -> (sub (𝕫:= s) ∘ ren (wren ρ ◃ᵣ 𝕫) ∘ (wsub σ₀ ◃ₛ var 𝕫)) v 208 | ≡ (ren ρ ∘ σ₀ ◃ₛ s) v 209 | eqᵉ 𝕫 = refl 210 | eqᵉ (𝕤 v) = 211 | begin 212 | sub (𝕫:= s) (ren (wren ρ ◃ᵣ 𝕫) (wsub σ₀ v)) 213 | ≡⟨ sub-ren _ _ (wsub σ₀ v) ⟩ 214 | sub (𝕫:= s ∘ (wren ρ ◃ᵣ 𝕫)) (wsub σ₀ v) 215 | ≡⟨ sub-ren _ _ (σ₀ v) ⟩ 216 | sub (var ∘ ρ) (σ₀ v) 217 | ≡˘⟨ sub-ren _ _ (σ₀ v) ⟩ 218 | sub var (ren ρ (σ₀ v)) 219 | ≡⟨ sub-var _ ⟩ 220 | ren ρ (σ₀ v) 221 | ∎ 222 | 223 | eq : _ 224 | eq = 225 | begin 226 | (sub (𝕫:= s) $ ren (wren ρ ◃ᵣ 𝕫) $ sub (wsub σ₀ ◃ₛ var 𝕫) t) 227 | ≡⟨ cong! (ren-sub _ _ t) ⟩ 228 | sub (𝕫:= s) (sub (ren (wren ρ ◃ᵣ 𝕫) ∘ (wsub σ₀ ◃ₛ var 𝕫)) t) 229 | ≡⟨ sub-sub _ _ t ⟩ 230 | sub (sub (𝕫:= s) ∘ ren (wren ρ ◃ᵣ 𝕫) ∘ (wsub σ₀ ◃ₛ var 𝕫)) t 231 | ≡⟨ subᵉ eqᵉ t ⟩ 232 | sub (ren ρ ∘ σ₀ ◃ₛ s) t 233 | ∎ 234 | 235 | G : Red 236 | (sub (var ◃ₛ s) $ 237 | ren (wren ρ ◃ᵣ 𝕫) $ 238 | sub (wsub σ₀ ◃ₛ var 𝕫) t) 239 | G rewrite eq = ⟦ t ⟧ λ 240 | { 𝕫 -> F 241 | ; (𝕤 v) -> Red-ren ρ (σ v) } 242 | 243 | -- Note that there are many complicated coherence lemmas for renaming 244 | -- and substitution. For the purpose of proving normalization only, they 245 | -- can be eschewed by replacing the Renaming in Red by a more restricted 246 | -- form --- order preserving renaming, or Thinning. 247 | 248 | -- In contrast to our "functional" style definition of Renaming and Substitution, 249 | -- Thinning is best defined inductively: 250 | -- data Thinning : Context -> Context -> Set where 251 | -- done : Thinning ∅ ∅ 252 | -- take : Thinning Γ Δ -> Thinning (Γ ◂ α) (Δ ◂ α) 253 | -- drop : Thinning Γ Δ -> Thinning (Γ ◂ α) Δ 254 | -- Exercise: Use Thinning to rewrite this file. 255 | -- Bonus Exercise: You can make it even cleaner with a maximally 256 | -- restricted type. Can you see how? 257 | 258 | -- And the normalization function, which throws the proof away. 259 | normalize : Term Γ α -> Term Γ α 260 | normalize t = reify (⟦ t ⟧ Red-id) .nf 261 | 262 | open benchmark 263 | -- Let's put our program to test! 264 | 265 | nbe-eta = normalize bench-eta 266 | nbe-beta = normalize bench-beta -- ^ ^ var 𝕫 267 | nbe-both = normalize bench-both -- ^ ^ ^ var (𝕤 𝕤 𝕫) ∙ var (𝕤 𝕫) ∙ var 𝕫 268 | nbe-rec = normalize bench-rec -- (# 720) 269 | -- Normalize them to see the result! 270 | 271 | nbe-rec-canon = canon (Normal-ℕ (reify (⟦ bench-rec ⟧ Red-id) .NF)) 272 | -- This should evaluate to (720 : Nat) 273 | -------------------------------------------------------------------------------- /STLC/nbe.py: -------------------------------------------------------------------------------- 1 | fresh = 0 2 | 3 | def reflect(prog): 4 | return lambda: (lambda: prog, lambda x: reflect(("app", reflect(prog), x))) 5 | 6 | def interpret(prog, env): 7 | global fresh 8 | if isinstance(prog, str): 9 | return env[prog] 10 | elif prog[0] == "lam": 11 | fresh += 1 12 | name = "x" + str(fresh) 13 | body = lambda x : interpret(prog[2], {**env, prog[1]: x}) 14 | return lambda: (lambda: ("lam", name, body(reflect(name))), body) 15 | elif prog[0] == "app": 16 | return lambda: interpret(prog[1], env)()[1](interpret(prog[2], env))() 17 | 18 | def reify(sem): 19 | sem = sem() 20 | if isinstance(sem[0], str): 21 | return sem[0] 22 | body = sem[0]() 23 | if body[0] == "lam": 24 | return ("lam", body[1], reify(body[2])) 25 | elif body[0] == "app": 26 | return ("app", reify(body[1]), reify(body[2])) 27 | 28 | def evaluate(prog): 29 | return reify(interpret(prog, {})) 30 | 31 | I = ("lam", "x", "x") 32 | K = ("lam", "x", ("lam", "y", "x")) 33 | TT = K 34 | S = ("lam", "x", ("lam", "y", ("lam", "z", ("app", ("app", "x", "z"), ("app", "y", "z"))))) 35 | SKK = ("app", ("app", S, K), K) 36 | omega = ("lam", "x", ("app", "x", "x")) 37 | Y = ("lam", "f", 38 | ("app", 39 | ("lam", "x", ("app", "f", ("app", "x", "x"))), 40 | ("lam", "x", ("app", "f", ("app", "x", "x"))))) 41 | Zero = ("lam", "x", ("lam", "y", "y")) 42 | FF = Zero 43 | Succ = ("lam", "n", 44 | ("lam", "f", 45 | ("lam", "x", 46 | ("app", "f", 47 | ("app", ("app", "n", "f"), "x"))))) 48 | def getNumber(n): 49 | if n == 0: return Zero 50 | else: return ("app", Succ, getNumber(n-1)) 51 | def toNumber(prog): 52 | number = -2 53 | while isinstance(prog, tuple): 54 | number += 1 55 | prog = prog[2] 56 | return number 57 | Add = ("lam", "m", ("lam", "n", 58 | ("lam", "f", ("lam", "x", 59 | ("app", ("app", "m", "f"), ("app", ("app", "n", "f"), "x")))))) 60 | Mult = ("lam", "m", ("lam", "n", 61 | ("lam", "f", 62 | ("app", "m", ("app", "n", "f"))))) 63 | Exp = ("lam", "m", ("lam", "n", ("app", "n", "m"))) 64 | IsZero = ("lam", "n", ("app", ("app", "n", ("app", K, FF)), TT)) 65 | Pred = ("lam", "n", ("lam", "f", ("lam", "x", 66 | ("app", ("app", ("app", "n", 67 | ("lam", "g", ("lam", "h", ("app", "h", ("app", "g", "f"))))), 68 | ("lam", "u", "x")), 69 | ("lam", "u", "u"))))) 70 | Fact = ("app", Y, ("lam", "f", 71 | ("lam", "n", 72 | ("app", ("app", ("app", IsZero, "n"), 73 | getNumber(1)), 74 | ("app", ("app", Mult, "n"), ("app", "f", ("app", Pred, "n"))))))) 75 | 76 | if __name__ == "__main__": 77 | print(toNumber(evaluate( 78 | ("app", Fact, getNumber(5)) 79 | ))) 80 | -------------------------------------------------------------------------------- /STLC/stlc.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --prop --postfix-projections --safe #-} 2 | module STLC.STLC where 3 | open import Agda.Builtin.Nat 4 | open import STLC.Equivalence 5 | open import combinator using (Type; ℕ; _⇒_) public 6 | 7 | -- We define contexts as lists of types. 8 | data Context : Set where 9 | ∅ : Context 10 | _◂_ : Context -> Type -> Context 11 | infixl 6 _◂_ 12 | 13 | private variable 14 | α β γ : Type 15 | Γ Δ : Context 16 | 17 | -- A variable is a de Bruijn index into the context. 18 | data Var : Context -> Type -> Set where 19 | 𝕫 : Var (Γ ◂ α) α 20 | 𝕤_ : Var Γ α -> Var (Γ ◂ β) α 21 | infixr 100 𝕤_ 22 | 23 | data Term : Context -> Type -> Set where 24 | var : Var Γ α -> Term Γ α 25 | ^_ : Term (Γ ◂ α) β -> Term Γ (α ⇒ β) 26 | _∙_ : Term Γ (α ⇒ β) -> Term Γ α -> Term Γ β 27 | -- If you are reading this for the first time, you should 28 | -- probably leave out anything concering the natural numbers. 29 | -- After you are familiar with all this, add these three construts in. 30 | O : Term Γ ℕ 31 | S : Term Γ (ℕ ⇒ ℕ) 32 | Rec : Term Γ (α ⇒ (ℕ ⇒ α ⇒ α) ⇒ ℕ ⇒ α) 33 | 34 | infixr 15 ^_ 35 | infixl 16 _∙_ 36 | 37 | -- Some familiar combinators 38 | 𝕀 : Term Γ (α ⇒ α) 39 | 𝕀 = ^ var 𝕫 40 | 41 | 𝕂 : Term Γ (α ⇒ β ⇒ α) 42 | 𝕂 = ^ ^ var (𝕤 𝕫) 43 | 44 | 𝕊 : Term Γ ((α ⇒ β ⇒ γ) ⇒ (α ⇒ β) ⇒ (α ⇒ γ)) 45 | 𝕊 = ^ ^ ^ (var (𝕤 𝕤 𝕫) ∙ var 𝕫) ∙ (var (𝕤 𝕫) ∙ var 𝕫) 46 | 47 | -- Converting Agda Nats to the term language. 48 | infix 100 #_ 49 | #_ : Nat -> Term Γ ℕ 50 | # zero = O 51 | # suc n = S ∙ # n 52 | 53 | -- A benchmark for normalization, will be used later. 54 | module benchmark where 55 | -- A very high-order type: 56 | High = ((ℕ ⇒ ℕ) ⇒ ℕ ⇒ ℕ) ⇒ (ℕ ⇒ ℕ) ⇒ ℕ 57 | 58 | -- This type is used to test eta-expansions. 59 | bench-eta : Term (∅ ◂ High) High 60 | bench-eta = var 𝕫 61 | 62 | -- Now for beta-reductions: 63 | Middle = ℕ ⇒ ℕ ⇒ ℕ 64 | twice : Term ∅ ((Middle ⇒ Middle) ⇒ (Middle ⇒ Middle)) 65 | twice = ^ ^ var (𝕤 𝕫) ∙ (var (𝕤 𝕫) ∙ var 𝕫) 66 | 67 | flip : Term ∅ (Middle ⇒ Middle) 68 | flip = ^ ^ ^ var (𝕤 𝕤 𝕫) ∙ var 𝕫 ∙ var (𝕤 𝕫) 69 | 70 | true : Term ∅ Middle 71 | true = 𝕂 72 | 73 | false : Term ∅ Middle 74 | false = 𝕂 ∙ 𝕀 75 | 76 | bench-beta : Term ∅ Middle 77 | bench-beta = twice ∙ flip ∙ false 78 | 79 | bench-both : Term ∅ (Middle ⇒ Middle) 80 | bench-both = twice ∙ flip 81 | 82 | -- Next we test the recursor. 83 | add : Term Γ Middle 84 | add = ^ ^ Rec ∙ var 𝕫 ∙ (^ S) ∙ var (𝕤 𝕫) 85 | 86 | mult : Term Γ Middle 87 | mult = ^ ^ Rec ∙ O ∙ (^ add ∙ var (𝕤 𝕫)) ∙ var (𝕤 𝕫) 88 | 89 | fact : Term ∅ (ℕ ⇒ ℕ) 90 | fact = ^ Rec ∙ (S ∙ O) ∙ (^ mult ∙ (S ∙ var 𝕫)) ∙ var 𝕫 91 | 92 | bench-rec : Term ∅ ℕ 93 | bench-rec = fact ∙ (# 6) 94 | 95 | -- We also demonstrate how to translate to SK-combinators. 96 | module SK-translation where 97 | -- To make induction go through, we also need variables. 98 | data SK (Γ : Context) : Type -> Set where 99 | var : Var Γ α -> SK Γ α 100 | 𝔎 : SK Γ (α ⇒ β ⇒ α) 101 | 𝔖 : SK Γ ((α ⇒ β ⇒ γ) ⇒ (α ⇒ β) ⇒ (α ⇒ γ)) 102 | 𝒪 : SK Γ ℕ 103 | 𝒮 : SK Γ (ℕ ⇒ ℕ) 104 | ℜ : SK Γ (α ⇒ (ℕ ⇒ α ⇒ α) ⇒ ℕ ⇒ α) 105 | _∙_ : SK Γ (α ⇒ β) -> SK Γ α -> SK Γ β 106 | -- This corresponds to Hilbert style deduction systems, 107 | -- except that we have hypotheses (variables). 108 | 109 | -- The deduction theorem of Hilbert-style propositional calculus, 110 | -- which proves that hypotheses are unnecessary. 111 | deduction : SK (Γ ◂ α) β -> SK Γ (α ⇒ β) 112 | deduction (var 𝕫) = 𝔖 ∙ 𝔎 ∙ (𝔎 {β = ℕ}) 113 | deduction (var (𝕤 v)) = 𝔎 ∙ var v 114 | deduction (c ∙ c') = 𝔖 ∙ deduction c ∙ deduction c' 115 | deduction 𝔎 = 𝔎 ∙ 𝔎 116 | deduction 𝔖 = 𝔎 ∙ 𝔖 117 | deduction 𝒪 = 𝔎 ∙ 𝒪 118 | deduction 𝒮 = 𝔎 ∙ 𝒮 119 | deduction ℜ = 𝔎 ∙ ℜ 120 | 121 | -- The translation. 122 | translate : Term Γ α -> SK Γ α 123 | translate (var v) = var v 124 | translate (^ t) = deduction (translate t) 125 | translate (t ∙ s) = translate t ∙ translate s 126 | translate O = 𝒪 127 | translate S = 𝒮 128 | translate Rec = ℜ 129 | 130 | -- Now we can compile closed terms to the combinators defined 131 | -- previously: 132 | coerce : SK ∅ α -> combinator.Term α 133 | coerce (c ∙ c') = coerce c combinator.∙ coerce c' 134 | coerce 𝔎 = combinator.𝕂 135 | coerce 𝔖 = combinator.𝕊 136 | coerce 𝒪 = combinator.O 137 | coerce 𝒮 = combinator.S 138 | coerce ℜ = combinator.ℝ 139 | 140 | compile : Term ∅ α -> combinator.Term α 141 | compile = coerce ∘ translate 142 | 143 | private variable 144 | s t u v : Term Γ α 145 | 146 | -- Next, we define basic term manipulations. 147 | -- These are standard constructions for well-typed de Bruijn terms. 148 | Renaming Substitution Function : Context -> Context -> Set 149 | Renaming Γ Δ = ∀ {α} -> Var Γ α -> Var Δ α 150 | Substitution Γ Δ = ∀ {α} -> Var Γ α -> Term Δ α 151 | Function Γ Δ = ∀ {α} -> Term Γ α -> Term Δ α 152 | 153 | infixl 6 _◃ᵣ_ 154 | _◃ᵣ_ : Renaming Γ Δ -> Var Δ α -> Renaming (Γ ◂ α) Δ 155 | (σ ◃ᵣ v) 𝕫 = v 156 | (σ ◃ᵣ _) (𝕤 v) = σ v 157 | 158 | wren : Renaming Γ Δ -> Renaming Γ (Δ ◂ α) 159 | wren ρ = 𝕤_ ∘ ρ 160 | 161 | ren : Renaming Γ Δ -> Function Γ Δ 162 | ren ρ (var v) = var (ρ v) 163 | ren ρ (^ t) = ^ ren (wren ρ ◃ᵣ 𝕫) t 164 | ren ρ (t ∙ s) = ren ρ t ∙ ren ρ s 165 | ren ρ O = O 166 | ren ρ S = S 167 | ren ρ Rec = Rec 168 | 169 | wsub : Substitution Γ Δ -> Substitution Γ (Δ ◂ α) 170 | wsub σ = ren 𝕤_ ∘ σ 171 | 172 | infixl 6 _◃ₛ_ 173 | _◃ₛ_ : Substitution Γ Δ -> Term Δ α -> Substitution (Γ ◂ α) Δ 174 | (σ ◃ₛ t) 𝕫 = t 175 | (σ ◃ₛ t) (𝕤 v) = σ v 176 | 177 | sub : Substitution Γ Δ -> Function Γ Δ 178 | sub σ (var v) = σ v 179 | sub σ (^ t) = ^ sub (wsub σ ◃ₛ var 𝕫) t 180 | sub σ (t ∙ s) = sub σ t ∙ sub σ s 181 | sub σ O = O 182 | sub σ S = S 183 | sub σ Rec = Rec 184 | 185 | infix 10 𝕫:=_ 186 | 𝕫:=_ : Term Γ α -> Substitution (Γ ◂ α) Γ 187 | 𝕫:= t = var ◃ₛ t 188 | 189 | -- Next, we define Normal terms. 190 | -- Naturally, a normal term is of the form 191 | -- ^ ^ ^ ... v ∙ ν₁ ∙ ν₂ ∙ ν₃ ... 192 | -- where v is a variable, and νₙ are all normal forms. 193 | -- (Of course, we still have O, S and Rec to consider.) 194 | -- This breaks the definition up into two stages. 195 | data Neutral : Term Γ α -> Set 196 | data Normal : Term Γ α -> Set 197 | 198 | data Neutral where -- Neutral terms are the inner part, without λs. 199 | var : (v : Var Γ α) -> Neutral (var v) 200 | _∙_ : Neutral s -> Normal t -> Neutral (s ∙ t) 201 | Rec : {a : Term Γ α} {f : Term Γ _} {n : Term Γ ℕ} 202 | -> Normal a -> Normal f -> Neutral n 203 | -> Neutral (Rec ∙ a ∙ f ∙ n) 204 | 205 | data Normal where -- Normal terms cap the λs up. 206 | ntr : {s : Term Γ ℕ} -> Neutral s -> Normal s 207 | -- Note the explicit type ascription (Term Γ ℕ). 208 | -- This means that a variable of type (ℕ ⇒ ℕ) is not normal! 209 | -- we need to eta-expand it into (λ x. f x). 210 | S : Normal s -> Normal (S ∙ s) 211 | O : Normal {Γ = Γ} O 212 | ^_ : Normal s -> Normal (^ s) 213 | -- We use ν for both normal and neutral terms. This can be disambiguated 214 | -- by the types. 215 | 216 | -- Natural numbers are normal: 217 | [#_] : (n : Nat) -> Normal {Γ = Γ} (# n) 218 | [# zero ] = O 219 | [# suc n ] = S [# n ] 220 | 221 | -- Normal natural numbers without variables are exactly of the form (# n). 222 | -- To prove this, we first prove that there are no neutral closed terms: 223 | Neutral-closed : {t : Term ∅ α} -> Neutral t -> ⊥ 224 | Neutral-closed (ν ∙ _) = Neutral-closed ν 225 | Neutral-closed (Rec _ _ ν) = Neutral-closed ν 226 | 227 | -- We use a datatype to describe this: 228 | data Canonical : Term ∅ ℕ -> Set where 229 | canonical : (n : Nat) -> Canonical (# n) 230 | canon : Canonical t -> Nat 231 | canon (canonical n) = n 232 | 233 | Normal-ℕ : Normal t -> Canonical t 234 | Normal-ℕ (ntr ν) with Neutral-closed ν 235 | ... | () 236 | Normal-ℕ (S ν) with Normal-ℕ ν 237 | ... | canonical n = canonical (suc n) 238 | Normal-ℕ O = canonical zero 239 | 240 | -- Next, we define reduction. 241 | infix 3 _~>!_ _~>_ _≈_ 242 | data _~>!_ : Term Γ α -> Term Γ α -> Prop where 243 | β! : {t : Term (Γ ◂ α) β} {s : Term Γ α} 244 | -> (^ t) ∙ s ~>! sub (𝕫:= s) t 245 | η! : {t : Term Γ (α ⇒ β)} 246 | -> t ~>! ^ ren 𝕤_ t ∙ var 𝕫 247 | ιₒ! : {t : Term Γ α} {s : Term _ _} 248 | -> Rec ∙ t ∙ s ∙ O ~>! t 249 | ιₛ! : {t : Term Γ α} {s : Term _ _} {n : Term _ _} 250 | -> Rec ∙ t ∙ s ∙ (S ∙ n) ~>! s ∙ n ∙ (Rec ∙ t ∙ s ∙ n) 251 | -- We define these in Prop, because we won't use them for computation. 252 | 253 | -- Congruence closure: 254 | data _~>_ : Term Γ α -> Term Γ α -> Prop where 255 | red : s ~>! t -> s ~> t 256 | ^_ : s ~> t -> ^ s ~> ^ t 257 | _~∙_ : s ~> t -> ∀ u -> s ∙ u ~> t ∙ u 258 | _∙~_ : (u : Term Γ (α ⇒ β)) -> s ~> t -> u ∙ s ~> u ∙ t 259 | infixl 16 _~∙_ _∙~_ 260 | 261 | -- Equivalence closure: 262 | _≈_ : Term Γ α -> Term Γ α -> Prop 263 | _≈_ = Equivalence _~>_ 264 | {-# DISPLAY Equivalence _~>_ = _≈_ #-} 265 | 266 | -- Read as a proposition: t is weakly normalizing. 267 | -- Read as a datatype: a normal form of t, carrying relevant proofs. 268 | record WN (t : Term Γ α) : Set where 269 | constructor wn 270 | field 271 | {nf} : Term Γ α 272 | NF : Normal nf 273 | Conv : t ≈ nf 274 | open WN 275 | pattern normal ν = wn ν refl 276 | 277 | -- Strongly normalizing terms. 278 | data SN : Term Γ α -> Set where 279 | sn : (∀ t -> s ~> t -> SN t) -> SN s 280 | -------------------------------------------------------------------------------- /STLC/substitution.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --prop --postfix-projections --safe #-} 2 | module STLC.Substitution where 3 | open import Agda.Builtin.Equality using (_≡_; refl) 4 | 5 | open import STLC.Equivalence 6 | open import STLC.STLC 7 | 8 | open import Relation.Binary.PropositionalEquality 9 | open ≡-Reasoning 10 | open import Tactic.Cong 11 | 12 | private variable 13 | α β γ : Type 14 | Γ Δ Ξ : Context 15 | 16 | -- ren and sub accepts a function, but only depends on the values 17 | -- of the function at specific points. This allows us to avoid 18 | -- the function extensionality axiom. 19 | private 20 | -- The pattern for these proofs: 21 | -- First prove a lemma concerning weakenings such as wren and wsub. 22 | -- Then use the lemma to make induction pass through. 23 | ren-auxᵉ : {ρ ρ' : Renaming Γ Δ} 24 | -> (eq : ∀ {α} (v : Var Γ α) -> ρ v ≡ ρ' v) 25 | -> ∀ {α} (v : Var (Γ ◂ β) α) 26 | -> (wren ρ ◃ᵣ 𝕫) v ≡ (wren ρ' ◃ᵣ 𝕫) v 27 | ren-auxᵉ eq 𝕫 = refl 28 | ren-auxᵉ eq (𝕤 v) rewrite eq v = refl 29 | 30 | renᵉ : {ρ ρ' : Renaming Γ Δ} 31 | -> (eq : ∀ {α} (v : Var Γ α) -> ρ v ≡ ρ' v) 32 | -> ∀ {α} (t : Term Γ α) -> ren ρ t ≡ ren ρ' t 33 | renᵉ eq (var v) rewrite eq v = refl 34 | renᵉ eq O = refl 35 | renᵉ eq S = refl 36 | renᵉ eq Rec = refl 37 | renᵉ eq (^ t) rewrite renᵉ (ren-auxᵉ eq) t = refl 38 | renᵉ eq (t ∙ s) rewrite renᵉ eq t | renᵉ eq s = refl 39 | 40 | private 41 | sub-auxᵉ : {σ σ' : Substitution Γ Δ} 42 | -> (eq : ∀ {α} (v : Var Γ α) -> σ v ≡ σ' v) 43 | -> ∀ {α} (v : Var (Γ ◂ β) α) 44 | -> (wsub σ ◃ₛ var 𝕫) v ≡ (wsub σ' ◃ₛ var 𝕫) v 45 | sub-auxᵉ eq 𝕫 = refl 46 | sub-auxᵉ eq (𝕤 v) rewrite eq v = refl 47 | 48 | subᵉ : {σ σ' : Substitution Γ Δ} 49 | -> (eq : ∀ {α} (v : Var Γ α) -> σ v ≡ σ' v) 50 | -> ∀ {α} (t : Term Γ α) -> sub σ t ≡ sub σ' t 51 | subᵉ eq (var v) = eq v 52 | subᵉ eq O = refl 53 | subᵉ eq S = refl 54 | subᵉ eq Rec = refl 55 | subᵉ eq (^ t) rewrite subᵉ (sub-auxᵉ eq) t = refl 56 | subᵉ eq (t ∙ s) rewrite subᵉ eq t | subᵉ eq s = refl 57 | 58 | -- Renaming with the identity does nothing. 59 | -- Note that we always prove an "extensional" version of the lemma, 60 | -- and then instantiate it with the regular arguments. 61 | private 62 | ren-id-auxᵉ : {ρ : Renaming Γ Γ} (eq : ∀ {α} (v : Var Γ α) -> ρ v ≡ v) 63 | -> ∀ {β α} (v : Var (Γ ◂ β) α) -> (wren ρ ◃ᵣ 𝕫) v ≡ v 64 | ren-id-auxᵉ eq 𝕫 = refl 65 | ren-id-auxᵉ eq (𝕤 v) rewrite eq v = refl 66 | 67 | ren-idᵉ : {ρ : Renaming Γ Γ} (eq : ∀ {α} (v : Var Γ α) -> ρ v ≡ v) (t : Term Γ α) 68 | -> ren ρ t ≡ t 69 | ren-idᵉ eq (var v) rewrite eq v = refl 70 | ren-idᵉ eq O = refl 71 | ren-idᵉ eq S = refl 72 | ren-idᵉ eq Rec = refl 73 | ren-idᵉ eq (^ t) 74 | rewrite ren-idᵉ (ren-id-auxᵉ eq) t = refl 75 | ren-idᵉ eq (t ∙ s) rewrite ren-idᵉ eq t | ren-idᵉ eq s = refl 76 | 77 | ren-id : (t : Term Γ α) -> ren id t ≡ t 78 | ren-id = ren-idᵉ λ _ -> refl 79 | 80 | -- Substituting each variable for itself does nothing. 81 | private 82 | sub-var-auxᵉ : {σ : Substitution Γ Γ} (eq : ∀ {α} (v : Var Γ α) -> σ v ≡ var v) 83 | -> ∀ {β α} (v : Var (Γ ◂ β) α) -> (wsub σ ◃ₛ var 𝕫) v ≡ var v 84 | sub-var-auxᵉ eq 𝕫 = refl 85 | sub-var-auxᵉ eq (𝕤 v) rewrite eq v = refl 86 | 87 | sub-varᵉ : {σ : Substitution Γ Γ} (eq : ∀ {α} (v : Var Γ α) -> σ v ≡ var v) (t : Term Γ α) 88 | -> sub σ t ≡ t 89 | sub-varᵉ eq (var v) rewrite eq v = refl 90 | sub-varᵉ eq O = refl 91 | sub-varᵉ eq S = refl 92 | sub-varᵉ eq Rec = refl 93 | sub-varᵉ eq (^ t) 94 | rewrite sub-varᵉ (sub-var-auxᵉ eq) t = refl 95 | sub-varᵉ eq (t ∙ s) rewrite sub-varᵉ eq t | sub-varᵉ eq s = refl 96 | 97 | sub-var : (t : Term Γ α) -> sub var t ≡ t 98 | sub-var = sub-varᵉ λ _ -> refl 99 | 100 | -- Renaming interacts with 𝕫:=_ 101 | ren-𝕫:= : (ρ : Renaming Γ Δ) (s : Term Γ α) (v : Var (Γ ◂ α) β) 102 | -> (𝕫:= ren ρ s) ((wren ρ ◃ᵣ 𝕫) v) ≡ ren ρ ((𝕫:= s) v) 103 | ren-𝕫:= ρ s 𝕫 = refl 104 | ren-𝕫:= ρ s (𝕤 v) = refl 105 | 106 | -- Composing two renamings. 107 | private 108 | wren-ren-auxᵉ : (σ : Renaming Δ Ξ) (τ : Renaming Γ Δ) (σ∘τ : Renaming Γ Ξ) 109 | -> (∀ {α} (v : Var Γ α) -> σ (τ v) ≡ σ∘τ v) 110 | -> ∀ {β α} (v : Var (Γ ◂ β) α) 111 | -> (wren σ ◃ᵣ 𝕫) ((wren τ ◃ᵣ 𝕫) v) ≡ (wren σ∘τ ◃ᵣ 𝕫) v 112 | wren-ren-auxᵉ σ τ σ∘τ eq 𝕫 = refl 113 | wren-ren-auxᵉ σ τ σ∘τ eq (𝕤 v) rewrite eq v = refl 114 | 115 | ren-renᵉ : (σ : Renaming Δ Ξ) (τ : Renaming Γ Δ) (σ∘τ : Renaming Γ Ξ) 116 | -> (∀ {α} (v : Var Γ α) -> σ (τ v) ≡ σ∘τ v) 117 | -> (t : Term Γ α) -> ren σ (ren τ t) ≡ ren σ∘τ t 118 | ren-renᵉ σ τ σ∘τ eq (var v) rewrite eq v = refl 119 | ren-renᵉ σ τ σ∘τ eq O = refl 120 | ren-renᵉ σ τ σ∘τ eq S = refl 121 | ren-renᵉ σ τ σ∘τ eq Rec = refl 122 | ren-renᵉ σ τ σ∘τ eq (^ t) 123 | rewrite ren-renᵉ (wren σ ◃ᵣ 𝕫) (wren τ ◃ᵣ 𝕫) _ 124 | (wren-ren-auxᵉ σ τ σ∘τ eq) t = refl 125 | ren-renᵉ σ τ σ∘τ eq (t ∙ s) 126 | rewrite ren-renᵉ σ τ σ∘τ eq t | ren-renᵉ σ τ σ∘τ eq s = refl 127 | 128 | ren-ren : (σ : Renaming Δ Ξ) (τ : Renaming Γ Δ) (t : Term Γ α) 129 | -> ren σ (ren τ t) ≡ ren (σ ∘ τ) t 130 | ren-ren σ τ = ren-renᵉ σ τ (σ ∘ τ) λ _ -> refl 131 | 132 | -- Composing renamining with substitution. 133 | private 134 | ren-sub-auxᵉ : ∀ (ρ : Renaming Δ Ξ) (σ : Substitution Γ Δ) 135 | (renρ∘σ : Substitution Γ Ξ) 136 | (eq : ∀ {α} (v : Var Γ α) -> ren ρ (σ v) ≡ renρ∘σ v) 137 | {α β} (v : Var (Γ ◂ α) β) 138 | -> ren (wren ρ ◃ᵣ 𝕫) ((wsub σ ◃ₛ var 𝕫) v) ≡ 139 | (wsub renρ∘σ ◃ₛ var 𝕫) v 140 | ren-sub-auxᵉ ρ σ renρ∘σ eq 𝕫 = refl 141 | ren-sub-auxᵉ ρ σ renρ∘σ eq {α = α} (𝕤 v) = 142 | begin 143 | ren (wren ρ ◃ᵣ 𝕫) (wsub σ v) 144 | ≡⟨ ren-ren _ _ (σ v) ⟩ 145 | ren (𝕤_ ∘ ρ) (σ v) 146 | ≡˘⟨ ren-ren _ _ (σ v) ⟩ 147 | ren 𝕤_ (ren ρ (σ v)) 148 | ≡⟨ cong! (eq v) ⟩ 149 | ren 𝕤_ (renρ∘σ v) 150 | ∎ 151 | 152 | ren-subᵉ : (ρ : Renaming Δ Ξ) (σ : Substitution Γ Δ) 153 | -> (renρ∘σ : Substitution Γ Ξ) 154 | -> (eq : ∀ {α} (v : Var Γ α) -> ren ρ (σ v) ≡ renρ∘σ v) 155 | -> (t : Term Γ α) 156 | -> ren ρ (sub σ t) ≡ sub renρ∘σ t 157 | ren-subᵉ ρ σ renρ∘σ eq (var v) = eq v 158 | ren-subᵉ ρ σ renρ∘σ eq O = refl 159 | ren-subᵉ ρ σ renρ∘σ eq S = refl 160 | ren-subᵉ ρ σ renρ∘σ eq Rec = refl 161 | ren-subᵉ ρ σ renρ∘σ eq (^ t) 162 | rewrite ren-subᵉ 163 | (wren ρ ◃ᵣ 𝕫) 164 | (wsub σ ◃ₛ var 𝕫) 165 | (wsub renρ∘σ ◃ₛ var 𝕫) 166 | (ren-sub-auxᵉ ρ σ renρ∘σ eq) t 167 | = refl 168 | ren-subᵉ ρ σ renρ∘σ eq (t ∙ s) 169 | rewrite ren-subᵉ ρ σ renρ∘σ eq t 170 | | ren-subᵉ ρ σ renρ∘σ eq s = refl 171 | 172 | ren-sub : (ρ : Renaming Δ Ξ) (σ : Substitution Γ Δ) (t : Term Γ α) 173 | -> ren ρ (sub σ t) ≡ sub (ren ρ ∘ σ) t 174 | ren-sub ρ σ = ren-subᵉ ρ σ (ren ρ ∘ σ) λ _ -> refl 175 | 176 | -- Composing substitution with renaming. 177 | private 178 | sub-ren-auxᵉ : (σ : Substitution Δ Ξ) (ρ : Renaming Γ Δ) 179 | -> (σ∘ρ : Substitution Γ Ξ) 180 | -> (eq : ∀ {α} (v : Var Γ α) -> σ (ρ v) ≡ σ∘ρ v) 181 | -> ∀ {α β} (v : Var (Γ ◂ α) β) 182 | -> (wsub σ ◃ₛ var 𝕫) ((wren ρ ◃ᵣ 𝕫) v) ≡ (wsub σ∘ρ ◃ₛ var 𝕫) v 183 | sub-ren-auxᵉ σ ρ σ∘ρ eq 𝕫 = refl 184 | sub-ren-auxᵉ σ ρ σ∘ρ eq (𝕤 v) rewrite eq v = refl 185 | 186 | sub-renᵉ : (σ : Substitution Δ Ξ) (ρ : Renaming Γ Δ) 187 | -> (σ∘ρ : Substitution Γ Ξ) 188 | -> (eq : ∀ {α} (v : Var Γ α) -> σ (ρ v) ≡ σ∘ρ v) 189 | -> (t : Term Γ α) 190 | -> sub σ (ren ρ t) ≡ sub σ∘ρ t 191 | sub-renᵉ σ ρ σ∘ρ eq (var v) = eq v 192 | sub-renᵉ σ ρ σ∘ρ eq O = refl 193 | sub-renᵉ σ ρ σ∘ρ eq S = refl 194 | sub-renᵉ σ ρ σ∘ρ eq Rec = refl 195 | sub-renᵉ σ ρ σ∘ρ eq (^ t) 196 | rewrite sub-renᵉ 197 | (wsub σ ◃ₛ var 𝕫) 198 | (wren ρ ◃ᵣ 𝕫) 199 | (wsub σ∘ρ ◃ₛ var 𝕫) 200 | (sub-ren-auxᵉ σ ρ σ∘ρ eq) t 201 | = refl 202 | sub-renᵉ σ ρ σ∘ρ eq (t ∙ s) 203 | rewrite sub-renᵉ σ ρ σ∘ρ eq t 204 | | sub-renᵉ σ ρ σ∘ρ eq s = refl 205 | 206 | sub-ren : (σ : Substitution Δ Ξ) (ρ : Renaming Γ Δ) 207 | -> (t : Term Γ α) 208 | -> sub σ (ren ρ t) ≡ sub (σ ∘ ρ) t 209 | sub-ren σ ρ = sub-renᵉ σ ρ (σ ∘ ρ) λ _ -> refl 210 | 211 | -- The final boss: Composing substitution with substitution. 212 | private 213 | sub-sub-auxᵉ : ∀ (τ : Substitution Δ Ξ) (σ : Substitution Γ Δ) 214 | (subτ∘σ : Substitution Γ Ξ) 215 | (eq : ∀ {α} (v : Var Γ α) -> sub τ (σ v) ≡ subτ∘σ v) 216 | {α β} (v : Var (Γ ◂ α) β) 217 | -> sub (wsub τ ◃ₛ var 𝕫) ((wsub σ ◃ₛ var 𝕫) v) ≡ 218 | (wsub subτ∘σ ◃ₛ var 𝕫) v 219 | sub-sub-auxᵉ τ σ subτ∘σ eq 𝕫 = refl 220 | sub-sub-auxᵉ τ σ subτ∘σ eq (𝕤 v) = 221 | begin -- recall that (wsub σ v) is just (ren 𝕤_ (σ v)). 222 | sub (wsub τ ◃ₛ var 𝕫) (wsub σ v) -- So the ren-lemmas apply. 223 | ≡⟨ sub-ren (wsub τ ◃ₛ var 𝕫) 𝕤_ (σ v) ⟩ 224 | sub (wsub τ) (σ v) 225 | ≡˘⟨ ren-sub 𝕤_ τ (σ v) ⟩ 226 | ren 𝕤_ (sub τ (σ v)) 227 | ≡⟨ cong! (eq v) ⟩ 228 | ren 𝕤_ (subτ∘σ v) 229 | ∎ 230 | 231 | sub-subᵉ : (τ : Substitution Δ Ξ) (σ : Substitution Γ Δ) 232 | -> (subτ∘σ : Substitution Γ Ξ) 233 | -> (eq : ∀ {α} (v : Var Γ α) -> sub τ (σ v) ≡ subτ∘σ v) 234 | -> (t : Term Γ α) 235 | -> sub τ (sub σ t) ≡ sub subτ∘σ t 236 | sub-subᵉ τ σ subτ∘σ eq (var v) = eq v 237 | sub-subᵉ τ σ subτ∘σ eq O = refl 238 | sub-subᵉ τ σ subτ∘σ eq S = refl 239 | sub-subᵉ τ σ subτ∘σ eq Rec = refl 240 | sub-subᵉ τ σ subτ∘σ eq (^ t) 241 | rewrite sub-subᵉ 242 | (wsub τ ◃ₛ var 𝕫) 243 | (wsub σ ◃ₛ var 𝕫) 244 | (wsub subτ∘σ ◃ₛ var 𝕫) 245 | (sub-sub-auxᵉ τ σ subτ∘σ eq) t 246 | = refl 247 | sub-subᵉ τ σ subτ∘σ eq (t ∙ s) 248 | rewrite sub-subᵉ τ σ subτ∘σ eq t 249 | | sub-subᵉ τ σ subτ∘σ eq s = refl 250 | 251 | sub-sub : (τ : Substitution Δ Ξ) (σ : Substitution Γ Δ) (t : Term Γ α) 252 | -> sub τ (sub σ t) ≡ sub (sub τ ∘ σ) t 253 | sub-sub τ σ = sub-subᵉ τ σ (sub τ ∘ σ) λ _ -> refl 254 | -------------------------------------------------------------------------------- /SystemF/SystemF.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --prop --postfix-projections --safe #-} 2 | module SystemF.SystemF where 3 | open import Agda.Builtin.Equality 4 | open import Data.Nat.Base using (ℕ; zero; suc) 5 | open import Data.Fin.Base using (Fin; zero; suc) 6 | open import Function.Base using (id; _∘_) 7 | 8 | variable 9 | m n : ℕ 10 | i j : Fin n 11 | 12 | data Raw : ℕ -> Set where 13 | var : Fin n -> Raw n 14 | Π_∙_ : Raw n -> Raw (suc n) -> Raw n 15 | ^_∙_ : Raw n -> Raw (suc n) -> Raw n 16 | _∙_ : Raw n -> Raw n -> Raw n 17 | ⋆ □ : Raw n 18 | 19 | data _⊆_ : ℕ -> ℕ -> Set where 20 | stop : 0 ⊆ 0 21 | keep : m ⊆ n -> suc m ⊆ suc n 22 | drop : m ⊆ n -> m ⊆ suc n 23 | 24 | ⊆-id : ∀ m -> m ⊆ m 25 | ⊆-id zero = stop 26 | ⊆-id (suc m) = keep (⊆-id m) 27 | 28 | ↑ : m ⊆ suc m 29 | ↑ = drop (⊆-id _) 30 | 31 | [_] : m ⊆ n -> Fin m -> Fin n 32 | [ keep ρ ] zero = zero 33 | [ keep ρ ] (suc i) = suc ([ ρ ] i) 34 | [ drop ρ ] i = suc ([ ρ ] i) 35 | 36 | ren : m ⊆ n -> Raw m -> Raw n 37 | ren ρ (var i) = var ([ ρ ] i) 38 | ren ρ (Π s ∙ t) = Π ren ρ s ∙ ren (keep ρ) t 39 | ren ρ (^ s ∙ t) = ^ ren ρ s ∙ ren (keep ρ) t 40 | ren ρ (t ∙ s) = ren ρ t ∙ ren ρ s 41 | ren ρ ⋆ = ⋆ 42 | ren ρ □ = □ 43 | 44 | Sub : ℕ -> ℕ -> Set 45 | Sub m n = Fin m -> Raw n 46 | 47 | infixl 5 _≪_ 48 | _≪_ : Sub m n -> Raw n -> Sub (suc m) n 49 | (ρ ≪ t) zero = t 50 | (ρ ≪ t) (suc i) = ρ i 51 | 52 | sub : Sub m n -> Raw m -> Raw n 53 | sub ρ (var i) = ρ i 54 | sub ρ (Π s ∙ t) = Π sub ρ s ∙ sub (ren ↑ ∘ ρ ≪ var zero) t 55 | sub ρ (^ s ∙ t) = ^ sub ρ s ∙ sub (ren ↑ ∘ ρ ≪ var zero) t 56 | sub ρ (t ∙ s) = sub ρ t ∙ sub ρ s 57 | sub ρ ⋆ = ⋆ 58 | sub ρ □ = □ 59 | 60 | 𝕫/ : Raw m -> Sub (suc m) m 61 | 𝕫/ t = var ∘ [ ⊆-id _ ] ≪ t 62 | 63 | data Sort {n} : Raw n -> Set where 64 | instance ⋆ : Sort ⋆ 65 | instance □ : Sort □ 66 | 67 | data Axiom {n} : Raw n -> Raw n -> Set where 68 | instance ⋆:□ : Axiom ⋆ □ 69 | 70 | data Product {n} : Raw n -> Raw (suc n) -> Raw n -> Set where 71 | instance func : Product ⋆ ⋆ ⋆ 72 | instance poly : Product □ ⋆ ⋆ 73 | 74 | infixr 10 Π_∙_ ^_∙_ 75 | infixl 15 _∙_ 76 | 77 | data Context : ℕ -> Set where 78 | ∅ : Context 0 79 | _◂_ : Context n -> Raw n -> Context (suc n) 80 | infixl 5 _◂_ 81 | 82 | variable 83 | Γ Δ : Context n 84 | s s₁ s₂ s₃ t t₁ t₂ t₃ u v w : Raw n 85 | 86 | infix 3 _⊢ctx _⊢_∈_ _⊢_~>_∈_ _⊢_⟶_∈_ _⊢_==_∈_ 87 | 88 | data _⊢ctx : Context n -> Prop 89 | data _⊢_∈_ : (Γ : Context n) -> Raw n -> Raw n -> Prop 90 | data _⊢_~>_∈_ : (Γ : Context n) -> Raw n -> Raw n -> Raw n -> Prop 91 | data _⊢_⟶_∈_ : (Γ : Context n) -> Raw n -> Raw n -> Raw n -> Prop 92 | data _⊢_==_∈_ (Γ : Context n) : Raw n -> Raw n -> Raw n -> Prop 93 | 94 | data _⊢ctx where 95 | ∅ : ∅ ⊢ctx 96 | _◂[_]_ : ∀ {Γ : Context n} -> Γ ⊢ctx 97 | -> ∀ s ⦃ _ : Sort s ⦄ 98 | -> ∀ {t} -> Γ ⊢ t ∈ s 99 | -> Γ ◂ t ⊢ctx 100 | 101 | data Var : Context n -> Fin n -> Raw n -> Prop where 102 | 𝕫 : ∀ s ⦃ _ : Sort s ⦄ 103 | -> ∀ {t} -> Γ ⊢ t ∈ s 104 | -> Var (Γ ◂ t) zero (ren ↑ t) 105 | 𝕤 : Var Γ i t 106 | -> ∀ s ⦃ _ : Sort s ⦄ 107 | -> ∀ {t'} -> Γ ⊢ t' ∈ s 108 | -> Var (Γ ◂ t') (suc i) (ren ↑ t) 109 | 110 | data _⊢_∈_ where 111 | axiom : ⦃ Axiom s₁ s₂ ⦄ 112 | -> Γ ⊢ctx 113 | -> Γ ⊢ s₁ ∈ s₂ 114 | var : Var Γ i t -> Γ ⊢ var i ∈ t 115 | prod : Γ ⊢ t ∈ s₁ 116 | -> Γ ◂ t ⊢ s ∈ s₂ 117 | -> ⦃ _ : Product s₁ s₂ s₃ ⦄ 118 | -> Γ ⊢ Π t ∙ s ∈ s₃ 119 | abs : Γ ◂ t₁ ⊢ s ∈ t₂ 120 | -> Γ ⊢ Π t₁ ∙ t₂ ∈ s₁ 121 | -> Γ ⊢ ^ t₁ ∙ s ∈ Π t₁ ∙ t₂ 122 | app : Γ ⊢ t ∈ Π t₁ ∙ t₂ 123 | -> Γ ⊢ s ∈ t₁ 124 | -> Γ ⊢ t ∙ s ∈ sub (𝕫/ s) t₂ 125 | conv : Γ ⊢ t ∈ s₁ 126 | -> Γ ⊢ s₁ == s₂ ∈ s 127 | -> Γ ⊢ t ∈ s₂ 128 | 129 | data _⊢_~>_∈_ where 130 | β! : Γ ◂ u ⊢ t ∈ v 131 | -> Γ ⊢ s ∈ u 132 | -> Γ ⊢ (^ u ∙ t) ∙ s ~> sub (𝕫/ s) t ∈ sub (𝕫/ s) v 133 | η! : Γ ⊢ t ∈ Π u ∙ v 134 | -> Γ ⊢ t ~> (^ u ∙ (ren ↑ t ∙ var zero)) ∈ Π u ∙ v 135 | 136 | data _⊢_⟶_∈_ where 137 | red : Γ ◂ u ⊢ t ∈ v 138 | -> Γ ⊢ s₁ ~> s₂ ∈ u 139 | -> Γ ⊢ sub (𝕫/ s₁) t ⟶ sub (𝕫/ s₂) t ∈ sub (𝕫/ s₁) v 140 | 141 | data _⊢_==_∈_ Γ where 142 | step : Γ ⊢ t₁ ⟶ t₂ ∈ u 143 | -> Γ ⊢ t₁ == t₂ ∈ u 144 | refl : Γ ⊢ t ∈ u 145 | -> Γ ⊢ t == t ∈ u 146 | symm : Γ ⊢ t == s ∈ u 147 | -> Γ ⊢ s == t ∈ u 148 | tran : Γ ⊢ s₁ == s₂ ∈ u 149 | -> Γ ⊢ s₂ == s₃ ∈ u 150 | -> Γ ⊢ s₁ == s₂ ∈ u 151 | conv : Γ ⊢ t₁ == t₂ ∈ u 152 | -> Γ ⊢ u == v ∈ s 153 | -> Γ ⊢ t₁ == t₂ ∈ v 154 | 155 | infixr 13 _⇒_ 156 | _⇒_ : Raw n -> Raw n -> Raw n 157 | t ⇒ s = Π t ∙ ren ↑ s 158 | 159 | ℐ : Raw 1 160 | ℐ = ^ var zero ∙ var zero 161 | 162 | 𝐼 : ∅ ◂ ⋆ ⊢ ℐ ∈ var zero ⇒ var zero 163 | 𝐼 = let α = 𝕫 □ (axiom ∅) in 164 | abs 165 | (var (𝕫 ⋆ (var α))) 166 | (prod (var α) (var (𝕤 α ⋆ (var α)))) 167 | 168 | 𝓘 : Raw 0 169 | 𝓘 = ^ ⋆ ∙ ℐ 170 | 171 | 𝑰 : ∅ ⊢ 𝓘 ∈ Π ⋆ ∙ var zero ⇒ var zero 172 | 𝑰 = let α = 𝕫 □ (axiom ∅) in 173 | abs 𝐼 (prod {s₁ = □} (axiom ∅) 174 | (prod (var α) 175 | (var (𝕤 α ⋆ 176 | (var α))))) 177 | -------------------------------------------------------------------------------- /combinator.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --prop --safe #-} 2 | module combinator where 3 | open import Agda.Builtin.Nat using (Nat; suc; zero) 4 | 5 | -- We work with the natural numbers as a base type. 6 | data Type : Set where 7 | ℕ : Type 8 | _⇒_ : Type -> Type -> Type 9 | infixr 10 _⇒_ 10 | 11 | private variable 12 | α β γ δ : Type 13 | n : Nat 14 | 15 | -- Now the combinators. 16 | data Term : Type -> Set where 17 | O : Term ℕ 18 | S : Term (ℕ ⇒ ℕ) 19 | ℝ : Term (α ⇒ (ℕ ⇒ α ⇒ α) ⇒ ℕ ⇒ α) 20 | -- ℝ takes a starting value A, an accumulating function F and 21 | -- a natural number N. It then calculates 22 | -- ℝ(A, F, N) = F(N-1, F(N-2, F(... F(0, A)))). 23 | 𝕂 : Term (α ⇒ β ⇒ α) 24 | 𝕊 : Term ((α ⇒ β ⇒ γ) ⇒ (α ⇒ β) ⇒ (α ⇒ γ)) 25 | _∙_ : Term (α ⇒ β) -> Term α -> Term β 26 | infixl 16 _∙_ 27 | 28 | private variable 29 | M N A B C : Term α 30 | 31 | -- Each natural number in Agda corresponds to a term S (S .. (S O)) 32 | -- in our combinator language. 33 | # : Nat -> Term ℕ 34 | # zero = O 35 | # (suc n) = S ∙ # n 36 | 37 | -- Some familiar combinators: 38 | 𝕀 : Term (α ⇒ α) 39 | 𝕀 = 𝕊 ∙ 𝕂 ∙ 𝕂 {β = ℕ} 40 | -- Here since β could be anything (it doesn't change the behaviour), Agda 41 | -- needs us to pick a specific type. 42 | 43 | ℂ : Term ((α ⇒ β ⇒ γ) ⇒ (β ⇒ α ⇒ γ)) 44 | ℂ = 𝕊 ∙ (𝕊 ∙ (𝕂 ∙ (𝕊 ∙ (𝕂 ∙ 𝕊) ∙ 𝕂)) ∙ 𝕊) ∙ (𝕂 ∙ 𝕂) 45 | 46 | 𝔹 : Term ((β ⇒ γ) ⇒ (α ⇒ β) ⇒ (α ⇒ γ)) 47 | 𝔹 = 𝕊 ∙ (𝕂 ∙ 𝕊) ∙ 𝕂 48 | 49 | 𝓢[_] : Term (α ⇒ β ⇒ γ ⇒ δ) -> Term ((α ⇒ β ⇒ γ) ⇒ α ⇒ β ⇒ δ) 50 | 𝓢[ t ] = 𝕊 ∙ (𝕊 ∙ (𝕂 ∙ 𝕊) ∙ t) 51 | 52 | 𝓚[_] : Term α -> Term (β ⇒ γ ⇒ α) 53 | 𝓚[ t ] = 𝕊 ∙ (𝕂 ∙ 𝕂) ∙ (𝕂 ∙ t) 54 | 55 | -- Using ℝ we can construct arithmetical functions: 56 | Add : Term (ℕ ⇒ ℕ ⇒ ℕ) 57 | Add = 𝕊 ∙ (𝕂 ∙ (𝕊 ∙ (𝕊 ∙ ℝ ∙ (𝕂 ∙ (𝕂 ∙ S))))) ∙ 𝕂 58 | 59 | -- Exercise: define multiplication and factorial. 60 | 61 | -- We need to define a set of normal forms. 62 | -- NF M means "M is in normal form". 63 | data NF : Term α -> Set where 64 | -- Numerals are normal. 65 | ℕ : ∀ n -> NF (# n) 66 | -- Note that instead of this we could have declared 67 | -- O₀ : NF O 68 | -- S₁ : NF A -> NF (S ∙ A) 69 | -- Exercise: what are the pros and cons for this choice? 70 | S₀ : NF S 71 | -- We also need to take care of partially applied combinators. 72 | -- The subscripts say how many arguments are already supplied. 73 | ℝ₀ : NF (ℝ {α = α}) 74 | ℝ₁ : NF A -> NF (ℝ {α = α} ∙ A) 75 | ℝ₂ : NF A -> NF B -> NF (ℝ ∙ A ∙ B) 76 | 𝕂₀ : NF (𝕂 {α = α} {β = β}) 77 | 𝕂₁ : NF A -> NF (𝕂 {β = β} ∙ A) 78 | 𝕊₀ : NF (𝕊 {α = α} {β = β} {γ = γ}) 79 | 𝕊₁ : NF A -> NF (𝕊 ∙ A) 80 | 𝕊₂ : NF A -> NF B -> NF (𝕊 ∙ A ∙ B) 81 | 82 | -- Next, we define reduction. 83 | infix 3 _~>_ _⟶₁_ _⟶_ 84 | -- _~>_ describes redexes, i.e. terms that can be reduced directly. 85 | data _~>_ : Term α -> Term α -> Prop where 86 | ℝ0 : ℝ ∙ A ∙ B ∙ O ~> A 87 | ℝS : ℝ ∙ B ∙ C ∙ (S ∙ A) ~> C ∙ A ∙ (ℝ ∙ B ∙ C ∙ A) 88 | 𝕂 : 𝕂 ∙ A ∙ B ~> A 89 | 𝕊 : 𝕊 ∙ A ∙ B ∙ C ~> (A ∙ C) ∙ (B ∙ C) 90 | 91 | -- _⟶₁_ describes single-step reductions. 92 | data _⟶₁_ {α} : Term α -> Term α -> Prop where 93 | red : A ~> B -> A ⟶₁ B 94 | appₗ : A ⟶₁ B -> A ∙ C ⟶₁ B ∙ C 95 | appᵣ : A ⟶₁ B -> C ∙ A ⟶₁ C ∙ B 96 | 97 | -- _⟶_ is the transitive closure of _⟶₁_. 98 | data _⟶_ {α} : Term α -> Term α -> Prop where 99 | refl : A ⟶ A 100 | step : A ⟶₁ B -> B ⟶ C -> A ⟶ C 101 | 102 | -- Auxiliary functions: 103 | -- Corresponds to singleton lists, list concatenation and maps. 104 | single : A ⟶₁ B -> A ⟶ B 105 | single r = step r refl 106 | {-# INLINE single #-} 107 | 108 | _⁀_ : A ⟶ B -> B ⟶ C -> A ⟶ C 109 | refl ⁀ R' = R' 110 | step r R ⁀ R' = step r (R ⁀ R') 111 | 112 | map : {F : Term α -> Term β} 113 | -> (∀ {A B} -> (A ⟶₁ B) -> (F A ⟶₁ F B)) 114 | -> (∀ {A B} -> (A ⟶ B) -> (F A ⟶ F B)) 115 | map f refl = refl 116 | map f (step r R) = step (f r) (map f R) 117 | 118 | -- WN A stores a normal form, and a proof that A reduces to that form. 119 | -- In other words, WN A means "A is weakly normalizing". 120 | data WN (A : Term α) : Set where -- Glue! 121 | wn : NF B -> A ⟶ B -> WN A 122 | 123 | -- SN A means "A is strongly normalizing", i.e. 𝑒𝑣𝑒𝑟𝑦 way to reduce A 124 | -- must eventually reach a normal form. 125 | data SN (A : Term α) : Set where 126 | sn : (∀ {B} -> A ⟶₁ B -> SN B) -> SN A 127 | 128 | open import Function.Base using (_$_) public 129 | 130 | infixl 10 _∘_ 131 | _∘_ : {P Q R : Prop} -- The _∘_ from stdlib doesn't work on Props 132 | -> (P -> Q) -> (R -> P) -> (R -> Q) 133 | (f ∘ g) z = f (g z) 134 | {-# INLINE _∘_ #-} 135 | -------------------------------------------------------------------------------- /nbe.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --prop #-} 2 | module nbe where 3 | open import Agda.Builtin.Nat using (Nat; suc; zero) 4 | open import Agda.Builtin.Equality using (_≡_; refl) 5 | open import Data.Product using (_×_; _,_; proj₁; proj₂) 6 | open import Data.Unit using (⊤) 7 | 8 | open import combinator 9 | 10 | private variable 11 | α β γ : Type 12 | n : Nat 13 | M N A B C : Term α 14 | 15 | -- We now take a differerent approach. 16 | -- Instead of blindly following the reduction rules, let's 17 | -- really find out what the combinator 𝑚𝑒𝑎𝑛𝑠. 18 | 19 | -- Since these are not part of the final program, I 20 | -- separate them into a private module. 21 | private module Meaning where 22 | -- What does the types mean? 23 | -- ℕ means the natural numbers Nat, no doubt. And 24 | -- (α ⇒ β) should mean the function space. 25 | -- So we might do the following: 26 | Meaning : Type -> Set 27 | Meaning ℕ = Nat 28 | Meaning (α ⇒ β) = Meaning α -> Meaning β 29 | -- Then, we want to 𝑖𝑛𝑡𝑒𝑟𝑝𝑟𝑒𝑡 the combinators to their Meaning. 30 | interpret : Term α -> Meaning α 31 | interpret O = zero 32 | interpret S = suc 33 | interpret ℝ = rec 34 | where 35 | rec : ∀ {A : Set} -> A -> (Nat -> A -> A) -> Nat -> A 36 | rec a f zero = a 37 | rec a f (suc n) = f n (rec a f n) 38 | interpret 𝕂 = λ z _ -> z 39 | interpret 𝕊 = λ x y z -> x z (y z) 40 | interpret (M ∙ N) = interpret M (interpret N) 41 | -- All work fine, and the most important thing is that if two things are 42 | -- considered equal, then their interpretations are equal: 43 | _ : interpret (𝕂 ∙ 𝕂 ∙ 𝕀 {ℕ}) ≡ λ (x : Nat) (y : Nat) -> x 44 | _ = refl 45 | _ : interpret (𝕂 ∙ 𝕂 ∙ 𝕊 {ℕ}{ℕ}{ℕ}) ≡ λ (x : Nat) (y : Nat) -> x 46 | _ = refl 47 | -- (There are some eta-equality related problems that we will not discuss here.) 48 | -- To make use of the interpretations, we need a way to convert 49 | -- the interpreted terms into normal forms. In other words: 50 | -- reify : Meaning α -> Term α 51 | -- But we can't do that. This is because in the function spaces, 52 | -- there are more functions than we can express in the combinator 53 | -- language! And if we worked in Set theory instead of Agda, there 54 | -- would be even more of those ghost functions. (Exercise: try to 55 | -- implement the function reify, and describe the difficulty you 56 | -- encounter.) 57 | 58 | -- What can we do to amend the situation? Actually we just need a 59 | -- very natural change. Note that in our previous implementation 60 | -- in reduce.agda, we only cared about the normal forms, i.e. the syntax. 61 | -- And in the development above, we only cared about the meanings, 62 | -- i.e. the semantics. This suggests the following change... 63 | 64 | -- For ℕ the meaning stays the same, but for 65 | -- function spaces, we require 𝑏𝑜𝑡ℎ a normal form 𝑎𝑛𝑑 a function. 66 | -- In Agda code: 67 | -- Meaning : Type -> Set 68 | -- Meaning ℕ = Nat 69 | -- Meaning (α ⇒ β) = NormalForm (α ⇒ β) × (Meaning α -> Meaning β) 70 | -- where NormalForm (which is not yet defined) is the type of normal 71 | -- forms. This is sufficient for programming purposes, and is close to 72 | -- the real-world implementations. But since we are using Agda, we 73 | -- shouldn't confine ourselves to programming. We should simultaneously 74 | -- produce a 𝑝𝑟𝑜𝑜𝑓 that the normal form can indeed be obtained from 75 | -- reducing the original term. This means that we also need to keep track 76 | -- of the original term. (After program extraction, the proofs are 77 | -- erased, so there's no additional cost in the program.) 78 | 79 | -- This produces the definition of (Red α A), which stands for 80 | -- "A is reducible of type α". Our new definition for the Meaning of α 81 | -- is exactly the reducible terms. 82 | -- The word "reducible" comes from Tait. We also adopt the convention 83 | -- to use ⟦ M ⟧ to denote the interpretation of M 84 | Red : ∀ α -> Term α -> Set -- Glue! 85 | Red α A = WN A × helper α A 86 | where 87 | helper : ∀ α -> Term α -> Set 88 | helper ℕ A = ⊤ 89 | helper (α ⇒ β) A = ∀ {B} -> Red α B -> Red β (A ∙ B) 90 | 91 | -- We can easily extract the normal form now. 92 | reify : Red α A -> WN A 93 | reify = proj₁ 94 | 95 | -- A very interesting lemma: if A reduces to B, and B is reducible, 96 | -- then A is also reducible. 97 | RedCl : (A ⟶ B) -> Red α B -> Red α A 98 | RedCl {α = ℕ} R (wn ν R' , _) = wn ν (R ⁀ R') , _ 99 | RedCl {α = α ⇒ β} R (wn ν R' , F) = wn ν (R ⁀ R') , 100 | λ ⟦C⟧ -> RedCl (map appₗ R) (F ⟦C⟧) 101 | 102 | -- The easy ones first. 103 | ⟦#_⟧ : ∀ n -> Red ℕ (# n) 104 | ⟦# n ⟧ = wn (ℕ n) refl , _ -- Agda can easily work out all these. 105 | 106 | ⟦S⟧ : Red ℕ A -> Red ℕ (S ∙ A) 107 | ⟦S⟧ (wn (ℕ n) R , _) = wn (ℕ (suc n)) (map appᵣ R) , _ 108 | 109 | -- The interpretation of 𝕂 is also simple, we invoke the lemma. 110 | -- Since (𝕂 ∙ A ∙ B) just reduces to A, so according to RedCl 111 | -- we just need to prove that A is reducible; which is the assumption. 112 | ⟦𝕂⟧ : Red α A -> Red β B -> Red α (𝕂 ∙ A ∙ B) 113 | ⟦𝕂⟧ ⟦A⟧ ⟦B⟧ = RedCl (single (red 𝕂)) ⟦A⟧ 114 | 115 | -- Now for partially applied 𝕂, we just need to make use of the previous case. 116 | ⟦𝕂₁⟧ : Red α A -> Red (β ⇒ α) (𝕂 ∙ A) 117 | ⟦𝕂₁⟧ ⟦A⟧ with reify ⟦A⟧ 118 | ... | wn ν R = wn (𝕂₁ ν) (map appᵣ R) , ⟦𝕂⟧ ⟦A⟧ 119 | 120 | -- Similarly for unapplied 𝕂. 121 | ⟦𝕂₀⟧ : Red (α ⇒ β ⇒ α) 𝕂 122 | ⟦𝕂₀⟧ = wn 𝕂₀ refl , ⟦𝕂₁⟧ 123 | 124 | ⟦𝕊⟧ : Red (α ⇒ β ⇒ γ) A 125 | -> Red (α ⇒ β) B 126 | -> Red α C 127 | -> Red γ (𝕊 ∙ A ∙ B ∙ C) 128 | ⟦𝕊⟧ ⟦A⟧ ⟦B⟧ ⟦C⟧ = RedCl (single (red 𝕊)) $ 129 | (⟦A⟧ .proj₂ ⟦C⟧) .proj₂ (⟦B⟧ .proj₂ ⟦C⟧) 130 | -- See how everything passes though without the need for the TERMINATING pragma? 131 | -- The interpretation of ⟦A⟧ includes a function that maps 132 | -- every C to the interpretation of (A ∙ C), and we just need 133 | -- to use .proj₂ to fetch it. 134 | 135 | ⟦𝕊₂⟧ : Red (α ⇒ β ⇒ γ) A -> Red (α ⇒ β) B -> Red (α ⇒ γ) (𝕊 ∙ A ∙ B) 136 | ⟦𝕊₂⟧ ⟦A⟧@(wn ν₁ R₁ , F₁) ⟦B⟧@(wn ν₂ R₂ , F₂) 137 | = wn (𝕊₂ ν₁ ν₂) (map appᵣ R₂ ⁀ map (appₗ ∘ appᵣ) R₁) , ⟦𝕊⟧ ⟦A⟧ ⟦B⟧ 138 | 139 | ⟦𝕊₁⟧ : Red (α ⇒ β ⇒ γ) A -> Red ((α ⇒ β) ⇒ (α ⇒ γ)) (𝕊 ∙ A) 140 | ⟦𝕊₁⟧ ⟦A⟧@(wn ν R , F) = wn (𝕊₁ ν) (map appᵣ R) , ⟦𝕊₂⟧ ⟦A⟧ 141 | 142 | ⟦𝕊₀⟧ : Red ((α ⇒ β ⇒ γ) ⇒ (α ⇒ β) ⇒ (α ⇒ γ)) 𝕊 143 | ⟦𝕊₀⟧ = wn 𝕊₀ refl , ⟦𝕊₁⟧ 144 | 145 | -- Now for the recursion operator. We first deal with the case 146 | -- where the natural number argument is alreadly calculated. 147 | ⟦ℝ_⟧ : ∀ n -> Red α B -> Red (ℕ ⇒ α ⇒ α) C -> Red α (ℝ ∙ B ∙ C ∙ (# n)) 148 | ⟦ℝ zero ⟧ ⟦B⟧ ⟦C⟧ = RedCl (single (red ℝ0)) ⟦B⟧ 149 | ⟦ℝ suc n ⟧ ⟦B⟧ ⟦C⟧ = RedCl (single (red ℝS)) $ 150 | ⟦C⟧ .proj₂ ⟦# n ⟧ .proj₂ (⟦ℝ n ⟧ ⟦B⟧ ⟦C⟧) 151 | 152 | -- The case where A may be neutral. 153 | ⟦ℝ⟧ : Red α B -> Red (ℕ ⇒ α ⇒ α) C -> Red ℕ A -> Red α (ℝ ∙ B ∙ C ∙ A) 154 | ⟦ℝ⟧ ⟦B⟧ ⟦C⟧ (wn (ℕ n) R , _) = 155 | RedCl (map appᵣ R) (⟦ℝ n ⟧ ⟦B⟧ ⟦C⟧) 156 | 157 | 158 | ⟦ℝ₂⟧ : Red α B -> Red (ℕ ⇒ α ⇒ α) C -> Red (ℕ ⇒ α) (ℝ ∙ B ∙ C) 159 | ⟦ℝ₂⟧ ⟦B⟧@(wn ν₁ R₁ , _) ⟦C⟧ with reify ⟦C⟧ 160 | ... | wn ν₂ R₂ = wn (ℝ₂ ν₁ ν₂) (map appᵣ R₂ ⁀ map (appₗ ∘ appᵣ) R₁) , ⟦ℝ⟧ ⟦B⟧ ⟦C⟧ 161 | 162 | ⟦ℝ₁⟧ : Red α A -> Red ((ℕ ⇒ α ⇒ α) ⇒ ℕ ⇒ α) (ℝ ∙ A) 163 | ⟦ℝ₁⟧ ⟦A⟧@(wn ν R , _) = wn (ℝ₁ ν) (map appᵣ R) , ⟦ℝ₂⟧ ⟦A⟧ 164 | 165 | ⟦ℝ₀⟧ : Red (α ⇒ (ℕ ⇒ α ⇒ α) ⇒ ℕ ⇒ α) ℝ 166 | ⟦ℝ₀⟧ = wn ℝ₀ refl , ⟦ℝ₁⟧ 167 | 168 | -- Finally, we collect everything together. 169 | -- Read as a theorem: Every term is reducible; 170 | -- Read as a program: A program that calculates the meaning of the terms. 171 | ⟦_⟧ : ∀ A -> Red α A 172 | ⟦ A ∙ B ⟧ = ⟦ A ⟧ .proj₂ ⟦ B ⟧ 173 | ⟦ 𝕂 ⟧ = ⟦𝕂₀⟧ 174 | ⟦ 𝕊 ⟧ = ⟦𝕊₀⟧ 175 | ⟦ ℝ ⟧ = ⟦ℝ₀⟧ 176 | ⟦ O ⟧ = ⟦# 0 ⟧ 177 | ⟦ S ⟧ = wn S₀ refl , ⟦S⟧ 178 | 179 | -- We can also get a normalizing function that throws away the proof. 180 | normalize : Term α -> Term α 181 | normalize A with reify ⟦ A ⟧ 182 | ... | wn {B = B} _ _ = B 183 | 184 | _ : normalize (Add ∙ # 30 ∙ # 30) ≡ # 60 185 | _ = refl 186 | 187 | -- Recall that we defined Red in terms of WN. Actually, replacing WN with 188 | -- SN, the proof also works, except for some tweaks. This then proves the 189 | -- strong normalization theorem. It is left as an exercise for the reader. 190 | -------------------------------------------------------------------------------- /nbe.py: -------------------------------------------------------------------------------- 1 | def interp(expr): 2 | if isinstance(expr, tuple): 3 | return interp(expr[0])[1](interp(expr[1])) 4 | elif expr == "S": 5 | return ("S", 6 | lambda a: (("S", a[0]), 7 | lambda b: (("S", a[0], b[0]), 8 | lambda c: (a[1](c)) [1] (b[1](c))))) 9 | elif expr == "K": 10 | return ("K", lambda a: (("K", a[0]), lambda _: a)) 11 | else: 12 | raise ValueError("Invalid expression:", expr) 13 | 14 | test = ((("S", "K"), "K"), "K") 15 | if __name__=="__main__": 16 | print(interp(test)[0]) 17 | -------------------------------------------------------------------------------- /reduce.agda: -------------------------------------------------------------------------------- 1 | {-# OPTIONS --prop #-} 2 | module reduce where 3 | open import Agda.Builtin.Nat using (Nat; suc; zero) 4 | open import Agda.Builtin.Equality using (_≡_; refl) 5 | 6 | open import combinator 7 | 8 | private variable 9 | α β γ : Type 10 | n : Nat 11 | M N A B C : Term α 12 | 13 | -- Defines big-step reduction semantics for our combinators. 14 | -- Read as a proposition: Every term is weakly normalizing. 15 | -- Read as a program: Reduces a term A to a normal form B, 16 | -- with proof that A reduces to B. 17 | -- This is quite standard, except that we also need to compute 18 | -- a proof alongside the normal form. 19 | 20 | {-# TERMINATING #-} 21 | reduce : (A : Term α) -> WN A 22 | reduceℝ : (A : Term α) (B : Term (ℕ ⇒ α ⇒ α)) (n : Nat) 23 | -> WN (ℝ ∙ A ∙ B ∙ # n) 24 | 25 | -- Numerals 26 | reduce O = wn (ℕ zero) refl 27 | reduce S = wn S₀ refl 28 | reduce (S ∙ A) with reduce A 29 | ... | wn (ℕ n) R = wn (ℕ (suc n)) (map appᵣ R) 30 | 31 | -- 𝕂 32 | reduce 𝕂 = wn 𝕂₀ refl 33 | reduce (𝕂 ∙ A) with reduce A 34 | ... | wn ν R = wn (𝕂₁ ν) (map appᵣ R) 35 | reduce (𝕂 ∙ A ∙ B) with reduce A 36 | ... | wn ν R = wn ν (step (red 𝕂) R) 37 | 38 | -- 𝕊 39 | reduce 𝕊 = wn 𝕊₀ refl 40 | reduce (𝕊 ∙ A) with reduce A 41 | ... | wn ν R = wn (𝕊₁ ν) (map appᵣ R) 42 | reduce (𝕊 ∙ A ∙ B) with reduce A | reduce B 43 | ... | wn ν₁ R₁ | wn ν₂ R₂ = wn (𝕊₂ ν₁ ν₂) 44 | (map (appₗ ∘ appᵣ) R₁ ⁀ map appᵣ R₂) 45 | reduce (𝕊 ∙ A ∙ B ∙ C) with reduce (A ∙ C ∙ (B ∙ C)) 46 | ... | wn ν R = wn ν (step (red 𝕊) R) 47 | 48 | -- ℝ 49 | reduce ℝ = wn ℝ₀ refl 50 | reduce (ℝ ∙ A) with reduce A 51 | ... | wn ν R = wn (ℝ₁ ν) (map appᵣ R) 52 | reduce (ℝ ∙ A ∙ B) with reduce A | reduce B 53 | ... | wn ν₁ R₁ | wn ν₂ R₂ = wn (ℝ₂ ν₁ ν₂) 54 | (map (appₗ ∘ appᵣ) R₁ ⁀ map appᵣ R₂) 55 | reduce (ℝ ∙ B ∙ C ∙ A) with reduce A 56 | ... | wn (ℕ n) R with reduceℝ B C n 57 | ... | wn ν R' = wn ν (map appᵣ R ⁀ R') 58 | 59 | reduce (A ∙ B) with reduce A 60 | ... | wn {B = A'} _ R' with reduce (A' ∙ B) 61 | ... | wn ν R = wn ν (map appₗ R' ⁀ R) 62 | 63 | reduceℝ A B zero with reduce A 64 | ... | wn ν R = wn ν (step (red ℝ0) R) 65 | reduceℝ A B (suc n) with reduce (B ∙ # n ∙ (ℝ ∙ A ∙ B ∙ # n)) 66 | ... | wn ν R = wn ν (step (red ℝS) R) 67 | 68 | -- fetches the normalized term, throwing away the proof. 69 | normalize : Term α -> Term α 70 | normalize A with reduce A 71 | ... | wn {B = B} _ _ = B 72 | 73 | _ : normalize (Add ∙ # 30 ∙ # 30) ≡ # 60 74 | _ = refl 75 | --------------------------------------------------------------------------------