[ { "path": ".clang-format", "content": "---\nLanguage: Cpp\nBasedOnStyle: Google\nIndentWidth: 4\n\nBreakBeforeBraces: Custom\nBraceWrapping:\n AfterCaseLabel: false\n AfterClass: true\n AfterControlStatement: MultiLine\n AfterEnum: false\n AfterFunction: true\n AfterNamespace: false\n AfterStruct: false\n AfterUnion: false\n AfterExternBlock: false\n BeforeCatch: false\n BeforeElse: false\n SplitEmptyFunction: false\n\nBinPackArguments: false\nAllowAllConstructorInitializersOnNextLine: false\nAllowAllParametersOfDeclarationOnNextLine: false\n\nAlignConsecutiveAssignments: true\n# This is good except it looks bad in function declarations.\nAlignConsecutiveDeclarations: true\nAlignConsecutiveMacros: true\nBreakConstructorInitializers: BeforeComma\nAlignTrailingComments: true\n\nDerivePointerAlignment: false\nPointerAlignment: Middle\n\n# For now, TODO: switch to Regroup\nIncludeBlocks: Preserve\n\n...\n" }, { "path": ".github/workflows/ci.yaml", "content": "#\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n\n# This workflow controls Plasma's continious integration. See documentation\n# for github workflows:\n#\n# * https://help.github.com/en/actions/configuring-and-managing-workflows/configuring-and-managing-workflow-files-and-runs\n# * https://help.github.com/en/actions/reference/workflow-syntax-for-github-actions\n#\n# And the action we use is here:\n# * https://github.com/PlasmaLang/ci\n\n\nname: CI\n\non: [push, pull_request]\n\njobs:\n test:\n name: Test (${{ matrix.buildType }} ${{ matrix.c }})\n runs-on: ubuntu-latest\n strategy:\n matrix:\n c: [gcc, clang]\n buildType: [dev, rel]\n fail-fast: false\n\n steps:\n - name: checkout\n uses: actions/checkout@v4\n - name: setup\n uses: PlasmaLang/ci/stable@v2_1\n with:\n command: setup\n c: ${{ matrix.c }}\n buildType: ${{ matrix.buildType }}\n - name: build\n uses: PlasmaLang/ci/stable@v2_1\n with:\n command: build\n - name: test\n uses: PlasmaLang/ci/stable@v2_1\n with:\n command: test\n - name: gctest\n uses: PlasmaLang/ci/stable@v2_1\n if: matrix.buildType == 'dev'\n with:\n command: gctest\n - name: copy-results\n uses: actions/upload-artifact@v4\n if: failure()\n with:\n name: test-results ${{ matrix.buildType }} ${{ matrix.c }}\n path: .\n retention-days: 7\n\n docs:\n name: Build docs\n runs-on: ubuntu-latest\n strategy:\n fail-fast: false\n\n steps:\n - name: checkout\n uses: actions/checkout@v4\n - name: docs\n uses: PlasmaLang/ci/docs@v1\n\n lint:\n name: Lint (${{ matrix.buildType }})\n runs-on: ubuntu-latest\n strategy:\n matrix:\n buildType: [dev, rel]\n fail-fast: false\n steps:\n - name: checkout\n uses: actions/checkout@v4\n - name: setup\n uses: PlasmaLang/ci/stable@v2_1\n with:\n command: setup\n c: clang\n buildType: ${{ matrix.buildType }}\n lint: lint\n - name: build\n uses: PlasmaLang/ci/stable@v2_1\n with:\n command: build\n - name: extra\n uses: PlasmaLang/ci/stable@v2_1\n with:\n command: extra\n\n" }, { "path": ".gitignore", "content": ".dep\n.docs_warning\n.mer_progs\nbuild.mk\n" }, { "path": ".gitmessage", "content": "[component(s)] Title\n\nDescription\n \nAny other changes including changes that were needed to support this\nchange or followed as a concequence of this change.\n\n# Current components are:\n# pz: the PZ file format,\n# pzrun: the runtime,\n# pzasm: the PZ assembler,\n# plasmac: the compiler generally,\n# plasmac/parse: the first phase: parsing.\n# plasmac/ast: the second phase: the AST and operations on it,\n# plasmac/pre: the third phase: the pre-core representation and operations,\n# plasmac/core: the fourth phase: the core representation and operations,\n# plasmac/pz: the fitht phase: the PZ code generator,\n# docs: documentation,\n# build: the build system,\n#\n# The title doesn't need to be a full English sentence.\n# You can use wildcards to convey groups of files if that\n# makes things easier to read. (for a human)\n\n" }, { "path": "CODE_OF_CONDUCT.md", "content": "# The Plasma Code of Conduct\n\nThe canonical version of this document can be found\n[in the master branch of the plasma repository](https://github.com/PlasmaLang/plasma/blob/master/CODE_OF_CONDUCT.md).\n\nWe are committed to providing a friendly and safe environment for all,\nregardless of level of experience, gender identity and expression, sexual\norientation, disability, personal appearance, body size, race, ethnicity,\nage, religion, nationality, relationship status or other similar\ncharacteristic.\n\n## Contact\n\nIf you have any questions or wish to report harassment\nyou may contact the Plasma community moderators by e-mailing\n[mods@plasmalang.org](mailto:mods@plasmalang.org).\nThis e-mail alias currently\nmessages Paul Bone only. Reports will be handled discreetly.\n\n## Rules for conduct\n\nAll participants are expected to follow these rules at all times.\n\n* Avoid using rude, sexual, or otherwise inappropriate nicknames or avatars.\n* Harassment is unwelcome behaviour, we will exclude anyone engaging in\n harassment. Harassment may include:\n * Violence, threats of violence or violent language directed against\n another person.\n * Discriminatory, hateful, or exclusionary jokes, language, remarks and\n behaviour.\n * Personal insults and cursing directed at another person,\n cursing at things is okay, but not with oppressive language.\n * Posting or displaying sexually explicit or violent material.\n * Posting or threatening to post other people’s personally identifying\n information (\"doxing\").\n * Inappropriate photography or recording.\n * Inappropriate physical contact. You should have someone’s consent before\n touching them.\n * Unwelcome sexual attention. This includes, sexualized comments or jokes;\n inappropriate touching, groping, and unwelcomed sexual advances.\n * Deliberate intimidation, stalking or following (online or in person).\n * Advocating for, or encouraging, any of the above behaviour.\n* Disruptive behaviour interferes with other people's ability to contribute\n or use Plasma.\n * Trolling, flaming, baiting or other attention-stealing\n behaviour is not welcome.\n * Sustained disruption of community events, including talks and\n presentations.\n* The moderators are responsible for maintaining a healthy and happy\n community, and this code of conduct may be subject to change or\n interpretation to achieve that.\n\n## Scope\n\n* These rules apply to the Discord server, github and the mailing lists and any\n other 'official' place as listed on http://plasmalang.org/contact.html\n* Private harassment is also unacceptable. Whether you're a regular\n contributor or a newcomer, if you feel you have been or are being harassed\n or made uncomfortable by a community member, please contact us (see\n above). We care about making this community a safe place for you and\n we've got your back.\n* Conduct outside the project may affect a person's eligibility to hold a\n position of responsibility (eg: code review, moderation), and may\n contribute to their standing within the Plasma community.\n\n## Good ideas for productive conduct\n\nWhen differences of opinion arise we want to have productive discussions,\nhere are some ideas for ensuring discussions remain productive and\nrespectful.\n\n* Respect that people have differences of opinion and that every design or\n implementation choice carries a trade-off and numerous costs.\n Disagreements about such decisions are okay so long as they are productive\n and everyone avoids personal attacks.\n* Please keep unstructured critique to a minimum. If you have solid ideas\n you want to experiment with, make a fork and see how it works.\n* When providing feedback, ask yourself \"Is this code/docs/etc better than\n before?\" not \"Is this contribution perfect?\", particularly for new\n contributors.\n* Spamming mailing lists, Discord server etc can make it difficult for\n other on-topic discussions to occur. Interruptions like these will be\n moderated if necessary. We do not forbid small off-topic discussions like\n \"How was your weekend?\" as they are usually positive for the community.\n\n## Moderation\n\nThese are the policies for upholding our community's standards of conduct.\nIf you feel that a discussion needs moderation, please contact the\nModeration Team (see above).\n\n1. Moderators will first respond with a warning for most violations. If the\n violation is particularly severe mods may exclude someone immediately and\n permanently.\n2. If the warning is unheeded, the user will be \"kicked,\" i.e., kicked out\n of the communication channel to cool off.\n3. If the user comes back and continues to make trouble, they will be\n banned, i.e., indefinitely excluded.\n4. Moderators may choose at their discretion to un-ban the user if it was a\n first offense and they offer the offended party a genuine apology.\n5. If a moderator bans someone and you think it was unjustified, please take\n it up with that moderator, or with a different moderator, **in private**.\n Complaints about bans in-channel are not allowed.\n\n* Moderators are held to a higher standard than other community members. If\n a moderator creates an inappropriate situation, they should expect less\n leeway than others.\n\nIn the Plasma community we strive to go the extra step to look out for each\nother. Don't just aim to be technically unimpeachable, try to be your best\nself. In particular, avoid flirting with offensive or sensitive issues,\nparticularly if they're off-topic; this all too often leads to unnecessary\nfights, hurt feelings, and damaged trust; worse, it can drive people away\nfrom the community entirely.\n\nAnd if someone takes issue with something you said or did, resist the urge\nto be defensive. Just stop doing what it was they complained about and\napologize. Even if you feel you were misinterpreted or unfairly accused,\nchances are good there was something you could've communicated better —\nremember that it's your responsibility to make your fellow contributors\ncomfortable. Everyone wants to get along and we are all here first and\nforemost because we want to talk about cool technology. You will find that\npeople will be eager to assume good intent and forgive as long as you earn\ntheir trust.\n\n## Other projects\n\nFor other projects adopting the Plasma Code of Conduct, please contact the\nmaintainers of those projects for enforcement. If you wish to use this code\nof conduct for your own project, consider explicitly mentioning your\nmoderation policy or making a copy with your own moderation policy so as to\navoid confusion.\n\n*Adapted from the\n[Rust Code of Conduct](https://www.rust-lang.org/en-US/conduct.html) and the\n[Citizen Code of Conduct](http://citizencodeofconduct.org/).\n[CC-BY-SA 3.0](https://creativecommons.org/licenses/by-sa/3.0/)*\n\n" }, { "path": "CONTRIBUTING.md", "content": "\n# Plasma Contributors' Information\n\nThis file contains information for potential and current Plasma\ncontributors.\n\n## Summary and legal stuff\n\n* We prefer github pull requests or patches mailed to the\n [developers' mailing list](https://plasmalang.org/lists/listinfo/dev).\n If you need to discuss a security issue confidently you can e-mail\n plasma at plasmalang dot org\n* The license of your contribution must match the project's licenses:\n * Code: MIT\n * Docs: CC BY-SA 4.0\n * Build scripts, tests, and sample code: Unlicense\n* No contributor agreement is required, you retain the copyright for your\n contribution.\n* Please follow the style guides as much as possible (see below)\n* Please format your log messages following the log message style (see\n below)\n* By submitting a PR you acknowledge these terms and agree to the\n [Code of Conduct](CODE_OF_CONDUCT.md)\n* By opening an issue/commenting/messaging you agree to the\n [Code of Conduct](CODE_OF_CONDUCT.md)\n\n## What and how to contribute\n\nFull contributing information is provided [in the contributors'\nguide](https://plasmalang.org/docs/contributing.html).\n\n## Submitting your changes\n\nAll code contributions must be made under the appropriate license:\n\n* Code: MIT\n* Docs: CC BY-SA 4.0\n* Build scripts, tests, and sample code: Unlicense\n\nNo transfer of copyright or other rights or permissions is required.\nInstead we ask contributors to list themselves (pseudonyms are okay) in the\nAUTHORS file, not only so we can credit and honor them but so that we know\nwho the copyright owners are. This could be important if, in the future,\nlicensing decisions need to be made (it's unlikely but it's best for\nPlasma).\n\nYou may choose not to be listed (e.g: if contributing a small fix) but doing\nso means that you agree that Paul Bone shall make any licensing decisions on\nyour behalf. You may add your name later when making a more significant\nchange.\n\nLog messages should follow the style:\n\n```\n [component(s)] Title\n\n Description\n\n Any other changes including changes that were needed to support this\n change or followed as a concequence of this change.\n```\n\nWe provide a .gitmessage in the root of the repository.\nRun this command to start using the new commit message template:\n\n```\ngit config --local commit.template /path/to/repo/.gitmessage\n```\n\n```components``` is one or more parts of the system. This helps people\nidentify (in mailing lists, change logs etc) what kind of change has been\nmade at a glace. It also helps people and software search for changes.\nCurrent components are:\n\n* pz: the PZ file format,\n* rt: the runtime generally,\n* rt/interp: the bytecode interpreter,\n* rt/gc: the garbage collector,\n* asm: the PZ assembler,\n* compiler: the compiler generally,\n* compiler/parse: the first phase: parsing.\n* compiler/ast: the second phase: the AST and operations on it,\n* compiler/pre: the third phase: the pre-core representation and operations,\n* compiler/core: the fourth phase: the core representation and operations,\n* compiler/pz: the fitht phase: the PZ code generator,\n* compiler/util: other utility code in the compiler,\n* link: the bytecode linker\n* build: the plzbuild tool,\n* docs: documentation,\n* scripts: the build system and other scripts,\n* tests: the test suite,\n\nSometimes it makes sense to pick the component with the most sagnificant\nchanges rather than listing all of them. This is typical for changes to the\ncompiler.\n\nEach patch should contain a single change and changes required by that\nchange (should compile and pass tests). Changes may e rolled together when\nthey're trivial related changes (eg, multiple spelling fixes).\n\nAlso, not a real component:\n\n* merge: for merge commits (see the maintainer's guide).\n\n" }, { "path": "LICENSE", "content": "\nCode\n----\n\nThe code except for lex.* are:\n\n Copyright (C) 2015-2025 Plasma Team\n Distributed under the terms of the MIT License see LICENSE.code\n\n The `git log` indicates the members of Plasma Team\n\n\nsrc/lex.*\n---------\n\nThe tools currently depend on the lex library for Mercury.\nhttps://github.com/Mercury-Language/mercury/tree/master/extras/lex\n\n Copyright (C) 2001-2002 Ralph Becket \n Copyright (C) 2001-2002 The Rationalizer Intelligent Software AG\n Copyright (C) 2002, 2006, 2010-2011 The University of Melbourne\n Copyright (C) 2015 Paul Bone\n Distributed under the terms of the LGPL (no version is specified in the\n original.\n\n\nExamples\n--------\n\n Examples and build scripts are released into the public domain. See\n LICENSE.unlicense\n\n\nDocumentation\n-------------\n\n The Plasma documentation (the contents of the doc/ directory, except for\n the style guides and asciidoc.css, plus the *.md files excluding\n CODE_OF_CONDUCT.md) is Copyright (C) 2015-2017 Plasma\n Team and made available under the Creative Commons\n Attribution-ShareAlike 4.0 International Public License\n See LICENSE.docs\n\n CODE_OF_CONDUCT.md is Copyright Plasma Team, Rust Project and various\n other authors. It is distributed under the Creative Commons\n Attribution-ShareAlike 3.0 license.\n\ndocs/*_Style.txt\n----------------\n\n The style guides are derrived from the Mercury Project's where their\n copyright and licenseing terms are unclear. We use them with permission.\n\n\ndocs/html/asciidoc.css\n----------------------\n\n Copyright (C) 2000-2007 Stuart Rackham\n License: GPL2 or later\n\n" }, { "path": "LICENSE.code", "content": "The MIT License (MIT)\n\nPermission is hereby granted, free of charge, to any person obtaining a copy\nof this software and associated documentation files (the \"Software\"), to\ndeal in the Software without restriction, including without limitation the\nrights to use, copy, modify, merge, publish, distribute, sublicense, and/or\nsell copies of the Software, and to permit persons to whom the Software is\nfurnished to do so, subject to the following conditions:\n\nThe above copyright notice and this permission notice shall be included in\nall copies or substantial portions of the Software.\n\nTHE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\nIMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\nFITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE\nAUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER\nLIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING\nFROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS\nIN THE SOFTWARE.\n\n" }, { "path": "LICENSE.docs", "content": "\nThe Plasma documentation (the contents of the doc/ directory, except for the\nstyle guides) is Copyright (C) 2015-2018 Plasma Team and made available\nunder the\n\n Creative Commons Attribution-ShareAlike 4.0 International\n Public License\n\nThe style guides are derived from the Mercury Project's where their\ncopyright and licensing terms are unclear. We use them with permission.\n\nThe license text is:\n\nBy exercising the Licensed Rights (defined below), You accept and agree\nto be bound by the terms and conditions of this Creative Commons\nAttribution-ShareAlike 4.0 International Public License (\"Public\nLicense\"). To the extent this Public License may be interpreted as a\ncontract, You are granted the Licensed Rights in consideration of Your\nacceptance of these terms and conditions, and the Licensor grants You\nsuch rights in consideration of benefits the Licensor receives from\nmaking the Licensed Material available under these terms and\nconditions.\n\n\nSection 1 -- Definitions.\n\n a. Adapted Material means material subject to Copyright and Similar\n Rights that is derived from or based upon the Licensed Material\n and in which the Licensed Material is translated, altered,\n arranged, transformed, or otherwise modified in a manner requiring\n permission under the Copyright and Similar Rights held by the\n Licensor. For purposes of this Public License, where the Licensed\n Material is a musical work, performance, or sound recording,\n Adapted Material is always produced where the Licensed Material is\n synched in timed relation with a moving image.\n\n b. Adapter's License means the license You apply to Your Copyright\n and Similar Rights in Your contributions to Adapted Material in\n accordance with the terms and conditions of this Public License.\n\n c. BY-SA Compatible License means a license listed at\n creativecommons.org/compatiblelicenses, approved by Creative\n Commons as essentially the equivalent of this Public License.\n\n d. Copyright and Similar Rights means copyright and/or similar rights\n closely related to copyright including, without limitation,\n performance, broadcast, sound recording, and Sui Generis Database\n Rights, without regard to how the rights are labeled or\n categorized. For purposes of this Public License, the rights\n specified in Section 2(b)(1)-(2) are not Copyright and Similar\n Rights.\n\n e. Effective Technological Measures means those measures that, in the\n absence of proper authority, may not be circumvented under laws\n fulfilling obligations under Article 11 of the WIPO Copyright\n Treaty adopted on December 20, 1996, and/or similar international\n agreements.\n\n f. Exceptions and Limitations means fair use, fair dealing, and/or\n any other exception or limitation to Copyright and Similar Rights\n that applies to Your use of the Licensed Material.\n\n g. License Elements means the license attributes listed in the name\n of a Creative Commons Public License. The License Elements of this\n Public License are Attribution and ShareAlike.\n\n h. Licensed Material means the artistic or literary work, database,\n or other material to which the Licensor applied this Public\n License.\n\n i. Licensed Rights means the rights granted to You subject to the\n terms and conditions of this Public License, which are limited to\n all Copyright and Similar Rights that apply to Your use of the\n Licensed Material and that the Licensor has authority to license.\n\n j. Licensor means the individual(s) or entity(ies) granting rights\n under this Public License.\n\n k. Share means to provide material to the public by any means or\n process that requires permission under the Licensed Rights, such\n as reproduction, public display, public performance, distribution,\n dissemination, communication, or importation, and to make material\n available to the public including in ways that members of the\n public may access the material from a place and at a time\n individually chosen by them.\n\n l. Sui Generis Database Rights means rights other than copyright\n resulting from Directive 96/9/EC of the European Parliament and of\n the Council of 11 March 1996 on the legal protection of databases,\n as amended and/or succeeded, as well as other essentially\n equivalent rights anywhere in the world.\n\n m. You means the individual or entity exercising the Licensed Rights\n under this Public License. Your has a corresponding meaning.\n\n\nSection 2 -- Scope.\n\n a. License grant.\n\n 1. Subject to the terms and conditions of this Public License,\n the Licensor hereby grants You a worldwide, royalty-free,\n non-sublicensable, non-exclusive, irrevocable license to\n exercise the Licensed Rights in the Licensed Material to:\n\n a. reproduce and Share the Licensed Material, in whole or\n in part; and\n\n b. produce, reproduce, and Share Adapted Material.\n\n 2. Exceptions and Limitations. For the avoidance of doubt, where\n Exceptions and Limitations apply to Your use, this Public\n License does not apply, and You do not need to comply with\n its terms and conditions.\n\n 3. Term. The term of this Public License is specified in Section\n 6(a).\n\n 4. Media and formats; technical modifications allowed. The\n Licensor authorizes You to exercise the Licensed Rights in\n all media and formats whether now known or hereafter created,\n and to make technical modifications necessary to do so. The\n Licensor waives and/or agrees not to assert any right or\n authority to forbid You from making technical modifications\n necessary to exercise the Licensed Rights, including\n technical modifications necessary to circumvent Effective\n Technological Measures. For purposes of this Public License,\n simply making modifications authorized by this Section 2(a)\n (4) never produces Adapted Material.\n\n 5. Downstream recipients.\n\n a. Offer from the Licensor -- Licensed Material. Every\n recipient of the Licensed Material automatically\n receives an offer from the Licensor to exercise the\n Licensed Rights under the terms and conditions of this\n Public License.\n\n b. Additional offer from the Licensor -- Adapted Material.\n Every recipient of Adapted Material from You\n automatically receives an offer from the Licensor to\n exercise the Licensed Rights in the Adapted Material\n under the conditions of the Adapter's License You apply.\n\n c. No downstream restrictions. You may not offer or impose\n any additional or different terms or conditions on, or\n apply any Effective Technological Measures to, the\n Licensed Material if doing so restricts exercise of the\n Licensed Rights by any recipient of the Licensed\n Material.\n\n 6. No endorsement. Nothing in this Public License constitutes or\n may be construed as permission to assert or imply that You\n are, or that Your use of the Licensed Material is, connected\n with, or sponsored, endorsed, or granted official status by,\n the Licensor or others designated to receive attribution as\n provided in Section 3(a)(1)(A)(i).\n\n b. Other rights.\n\n 1. Moral rights, such as the right of integrity, are not\n licensed under this Public License, nor are publicity,\n privacy, and/or other similar personality rights; however, to\n the extent possible, the Licensor waives and/or agrees not to\n assert any such rights held by the Licensor to the limited\n extent necessary to allow You to exercise the Licensed\n Rights, but not otherwise.\n\n 2. Patent and trademark rights are not licensed under this\n Public License.\n\n 3. To the extent possible, the Licensor waives any right to\n collect royalties from You for the exercise of the Licensed\n Rights, whether directly or through a collecting society\n under any voluntary or waivable statutory or compulsory\n licensing scheme. In all other cases the Licensor expressly\n reserves any right to collect such royalties.\n\n\nSection 3 -- License Conditions.\n\nYour exercise of the Licensed Rights is expressly made subject to the\nfollowing conditions.\n\n a. Attribution.\n\n 1. If You Share the Licensed Material (including in modified\n form), You must:\n\n a. retain the following if it is supplied by the Licensor\n with the Licensed Material:\n\n i. identification of the creator(s) of the Licensed\n Material and any others designated to receive\n attribution, in any reasonable manner requested by\n the Licensor (including by pseudonym if\n designated);\n\n ii. a copyright notice;\n\n iii. a notice that refers to this Public License;\n\n iv. a notice that refers to the disclaimer of\n warranties;\n\n v. a URI or hyperlink to the Licensed Material to the\n extent reasonably practicable;\n\n b. indicate if You modified the Licensed Material and\n retain an indication of any previous modifications; and\n\n c. indicate the Licensed Material is licensed under this\n Public License, and include the text of, or the URI or\n hyperlink to, this Public License.\n\n 2. You may satisfy the conditions in Section 3(a)(1) in any\n reasonable manner based on the medium, means, and context in\n which You Share the Licensed Material. For example, it may be\n reasonable to satisfy the conditions by providing a URI or\n hyperlink to a resource that includes the required\n information.\n\n 3. If requested by the Licensor, You must remove any of the\n information required by Section 3(a)(1)(A) to the extent\n reasonably practicable.\n\n b. ShareAlike.\n\n In addition to the conditions in Section 3(a), if You Share\n Adapted Material You produce, the following conditions also apply.\n\n 1. The Adapter's License You apply must be a Creative Commons\n license with the same License Elements, this version or\n later, or a BY-SA Compatible License.\n\n 2. You must include the text of, or the URI or hyperlink to, the\n Adapter's License You apply. You may satisfy this condition\n in any reasonable manner based on the medium, means, and\n context in which You Share Adapted Material.\n\n 3. You may not offer or impose any additional or different terms\n or conditions on, or apply any Effective Technological\n Measures to, Adapted Material that restrict exercise of the\n rights granted under the Adapter's License You apply.\n\n\nSection 4 -- Sui Generis Database Rights.\n\nWhere the Licensed Rights include Sui Generis Database Rights that\napply to Your use of the Licensed Material:\n\n a. for the avoidance of doubt, Section 2(a)(1) grants You the right\n to extract, reuse, reproduce, and Share all or a substantial\n portion of the contents of the database;\n\n b. if You include all or a substantial portion of the database\n contents in a database in which You have Sui Generis Database\n Rights, then the database in which You have Sui Generis Database\n Rights (but not its individual contents) is Adapted Material,\n\n including for purposes of Section 3(b); and\n c. You must comply with the conditions in Section 3(a) if You Share\n all or a substantial portion of the contents of the database.\n\nFor the avoidance of doubt, this Section 4 supplements and does not\nreplace Your obligations under this Public License where the Licensed\nRights include other Copyright and Similar Rights.\n\n\nSection 5 -- Disclaimer of Warranties and Limitation of Liability.\n\n a. UNLESS OTHERWISE SEPARATELY UNDERTAKEN BY THE LICENSOR, TO THE\n EXTENT POSSIBLE, THE LICENSOR OFFERS THE LICENSED MATERIAL AS-IS\n AND AS-AVAILABLE, AND MAKES NO REPRESENTATIONS OR WARRANTIES OF\n ANY KIND CONCERNING THE LICENSED MATERIAL, WHETHER EXPRESS,\n IMPLIED, STATUTORY, OR OTHER. THIS INCLUDES, WITHOUT LIMITATION,\n WARRANTIES OF TITLE, MERCHANTABILITY, FITNESS FOR A PARTICULAR\n PURPOSE, NON-INFRINGEMENT, ABSENCE OF LATENT OR OTHER DEFECTS,\n ACCURACY, OR THE PRESENCE OR ABSENCE OF ERRORS, WHETHER OR NOT\n KNOWN OR DISCOVERABLE. WHERE DISCLAIMERS OF WARRANTIES ARE NOT\n ALLOWED IN FULL OR IN PART, THIS DISCLAIMER MAY NOT APPLY TO YOU.\n\n b. TO THE EXTENT POSSIBLE, IN NO EVENT WILL THE LICENSOR BE LIABLE\n TO YOU ON ANY LEGAL THEORY (INCLUDING, WITHOUT LIMITATION,\n NEGLIGENCE) OR OTHERWISE FOR ANY DIRECT, SPECIAL, INDIRECT,\n INCIDENTAL, CONSEQUENTIAL, PUNITIVE, EXEMPLARY, OR OTHER LOSSES,\n COSTS, EXPENSES, OR DAMAGES ARISING OUT OF THIS PUBLIC LICENSE OR\n USE OF THE LICENSED MATERIAL, EVEN IF THE LICENSOR HAS BEEN\n ADVISED OF THE POSSIBILITY OF SUCH LOSSES, COSTS, EXPENSES, OR\n DAMAGES. WHERE A LIMITATION OF LIABILITY IS NOT ALLOWED IN FULL OR\n IN PART, THIS LIMITATION MAY NOT APPLY TO YOU.\n\n c. The disclaimer of warranties and limitation of liability provided\n above shall be interpreted in a manner that, to the extent\n possible, most closely approximates an absolute disclaimer and\n waiver of all liability.\n\n\nSection 6 -- Term and Termination.\n\n a. This Public License applies for the term of the Copyright and\n Similar Rights licensed here. However, if You fail to comply with\n this Public License, then Your rights under this Public License\n terminate automatically.\n\n b. Where Your right to use the Licensed Material has terminated under\n Section 6(a), it reinstates:\n\n 1. automatically as of the date the violation is cured, provided\n it is cured within 30 days of Your discovery of the\n violation; or\n\n 2. upon express reinstatement by the Licensor.\n\n For the avoidance of doubt, this Section 6(b) does not affect any\n right the Licensor may have to seek remedies for Your violations\n of this Public License.\n\n c. For the avoidance of doubt, the Licensor may also offer the\n Licensed Material under separate terms or conditions or stop\n distributing the Licensed Material at any time; however, doing so\n will not terminate this Public License.\n\n d. Sections 1, 5, 6, 7, and 8 survive termination of this Public\n License.\n\n\nSection 7 -- Other Terms and Conditions.\n\n a. The Licensor shall not be bound by any additional or different\n terms or conditions communicated by You unless expressly agreed.\n\n b. Any arrangements, understandings, or agreements regarding the\n Licensed Material not stated herein are separate from and\n independent of the terms and conditions of this Public License.\n\n\nSection 8 -- Interpretation.\n\n a. For the avoidance of doubt, this Public License does not, and\n shall not be interpreted to, reduce, limit, restrict, or impose\n conditions on any use of the Licensed Material that could lawfully\n be made without permission under this Public License.\n\n b. To the extent possible, if any provision of this Public License is\n deemed unenforceable, it shall be automatically reformed to the\n minimum extent necessary to make it enforceable. If the provision\n cannot be reformed, it shall be severed from this Public License\n without affecting the enforceability of the remaining terms and\n conditions.\n\n c. No term or condition of this Public License will be waived and no\n failure to comply consented to unless expressly agreed to by the\n Licensor.\n\n d. Nothing in this Public License constitutes or may be interpreted\n as a limitation upon, or waiver of, any privileges and immunities\n that apply to the Licensor or You, including from the legal\n processes of any jurisdiction or authority.\n\n\n=======================================================================\n\nCreative Commons is not a party to its public\nlicenses. Notwithstanding, Creative Commons may elect to apply one of\nits public licenses to material it publishes and in those instances\nwill be considered the “Licensor.” The text of the Creative Commons\npublic licenses is dedicated to the public domain under the CC0 Public\nDomain Dedication. Except for the limited purpose of indicating that\nmaterial is shared under a Creative Commons public license or as\notherwise permitted by the Creative Commons policies published at\ncreativecommons.org/policies, Creative Commons does not authorize the\nuse of the trademark \"Creative Commons\" or any other trademark or logo\nof Creative Commons without its prior written consent including,\nwithout limitation, in connection with any unauthorized modifications\nto any of its public licenses or any other arrangements,\nunderstandings, or agreements concerning use of licensed material. For\nthe avoidance of doubt, this paragraph does not form part of the\npublic licenses.\n\nCreative Commons may be contacted at creativecommons.org.\n\n\n" }, { "path": "LICENSE.unlicense", "content": "\nSome files in this project are free and unencumbered software released into\nthe public domain.\n\nAnyone is free to copy, modify, publish, use, compile, sell, or distribute\nthis software, either in source code form or as a compiled binary, for any\npurpose, commercial or non-commercial, and by any means.\n\nIn jurisdictions that recognize copyright laws, the author or authors of\nthis software dedicate any and all copyright interest in the software to the\npublic domain. We make this dedication for the benefit of the public at\nlarge and to the detriment of our heirs and successors. We intend this\ndedication to be an overt act of relinquishment in perpetuity of all present\nand future rights to this software under copyright law.\n\nTHE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\nIMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\nFITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE\nAUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN\nACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION\nWITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.\n\nFor more information, please refer to \n\n" }, { "path": "Makefile", "content": "#\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# vim: noet sw=4 ts=4\n#\n\n# ======================\n# \n# No configuration here\n# See build.mk\ninclude defaults.mk\n-include build.mk\n#\n# ======================\n\n# As the build system gets more complex I want to avoid autoconf. Perhaps\n# instead create a config.h and makefile for each major OS+platform\n# combination. An optional configure script could put the right file in\n# place. Also consider autosetup.\n\nvpath %.m src\nvpath %.c runtime\nvpath %.cpp runtime\nvpath %.h runtime\nvpath %.o runtime\nvpath %.txt docs\nvpath %.html docs/html\n\nMERCURY_SOURCES=$(wildcard src/*.m)\n\n# There are no C sources but we keep this in case we add some C code (eg\n# a library interface.) The tags target will need to be fixed if C sources\n# are added.\nC_SOURCES=\n\n# NOTE that when we add alternative interpreters we'll need to seperate out\n# the generic files, that includes updating pz_closure.h so it includes\n# different files.\nCXX_SOURCES=runtime/pz_main.cpp \\\n\t\truntime/pz.cpp \\\n\t\truntime/pz_builtin.cpp \\\n\t\truntime/pz_code.cpp \\\n\t\truntime/pz_data.cpp \\\n\t\truntime/pz_foreign.cpp \\\n\t\truntime/pz_generic_closure.cpp \\\n\t\truntime/pz_generic_builtin.cpp \\\n\t\truntime/pz_generic_run.cpp \\\n\t\truntime/pz_gc.cpp \\\n\t\truntime/pz_gc_alloc.cpp \\\n\t\truntime/pz_gc_collect.cpp \\\n\t\truntime/pz_gc_util.cpp \\\n\t\truntime/pz_instructions.cpp \\\n\t\truntime/pz_io.cpp \\\n\t\truntime/pz_library.cpp \\\n\t\truntime/pz_memory.cpp \\\n\t\truntime/pz_option.cpp \\\n\t\truntime/pz_read.cpp \\\n\t\truntime/pz_string.cpp \\\n\t\truntime/pz_generic.cpp \\\n\t\truntime/pz_generic_builder.cpp\n\nC_CXX_SOURCES=$(C_SOURCES) $(CXX_SOURCES)\nC_HEADERS=$(wildcard runtime/*.h)\nOBJECTS=$(patsubst %.c,%.o,$(C_SOURCES)) $(patsubst %.cpp,%.o,$(CXX_SOURCES))\n\nDOCS_HTML=docs/index.html \\\n\tdocs/getting_started.html \\\n\tdocs/user_guide.html \\\n\tdocs/plasma_ref.html \\\n\tdocs/contributing.html \\\n\tdocs/dev_howto_make_pr.html \\\n\tdocs/dev_compiler_internals.html \\\n\tdocs/dev_testing.html \\\n\tdocs/dev_style_mercury.html \\\n\tdocs/dev_style_c.html \\\n\tdocs/dev_mercury_grades.html \\\n\tdocs/dev_maintainers.html \\\n\tdocs/dev_bugtracking.html \\\n\tdocs/design_principles.html \\\n\tdocs/design_concept_map.html \\\n\tdocs/design_types.html \\\n\tdocs/design_ideas.html \\\n\tdocs/references.html \\\n\tdocs/pz_machine.html\n\n# Extra development modules\nifeq ($(BUILD_TYPE),dev)\n\tCXX_SOURCES+= \\\n\t\truntime/pz_gc_debug.cpp \\\n\t\truntime/pz_trace.cpp\nelse\nendif\n\nifneq ($(shell which $(ASCIIDOC)),)\n\tDOCS_TARGETS=$(DOCS_HTML)\nelse\n\tDOCS_TARGETS=.docs_warning\nendif\n\nCFLAGS=$(DEPFLAGS) $(C_CXX_FLAGS) $(C_ONLY_FLAGS)\nCXXFLAGS=$(DEPFLAGS) $(C_CXX_FLAGS) $(CXX_ONLY_FLAGS)\n$(shell mkdir -p $(DEPDIR)/runtime >/dev/null)\n\n.SUFFIXES:\n\n.PHONY: all\nall : progs docs\n\n.PHONY: progs\nprogs : \\\n\truntime/plzrun \\\n\tsrc/plzasm \\\n\tsrc/plzbuild \\\n\tsrc/plzc \\\n\tsrc/plzdisasm \\\n\tsrc/plzgeninit \\\n\tsrc/plzlnk\n\n.PHONY: install\ninstall: install_progs install_docs install_examples\n\n.PHONY: install_dirs\ninstall_dirs:\n\t$(INSTALL_DIR) $(DEST_DIR)$(BINDIR)\n\t$(INSTALL_DIR) $(DEST_DIR)$(DOCDIR)\n\n.PHONY: install_progs\ninstall_progs : install_dirs progs\n\t$(INSTALL_STRIP) runtime/plzrun $(DEST_DIR)$(BINDIR)\n\t$(INSTALL_STRIP) src/plzasm $(DEST_DIR)$(BINDIR)\n\t$(INSTALL_STRIP) src/plzbuild $(DEST_DIR)$(BINDIR)\n\t$(INSTALL_STRIP) src/plzc $(DEST_DIR)$(BINDIR)\n\t$(INSTALL_STRIP) src/plzdisasm $(DEST_DIR)$(BINDIR)\n\t$(INSTALL_STRIP) src/plzgeninit $(DEST_DIR)$(BINDIR)\n\t$(INSTALL_STRIP) src/plzlnk $(DEST_DIR)$(BINDIR)\n\n.PHONY: install_docs\ninstall_docs : install_dirs docs\n\tcd docs/ ; for FILE in $$(find -name '*.txt' -o -name '*.html' ); do \\\n\t\t$(INSTALL) $$FILE $(DEST_DIR)$(DOCDIR); \\\n\tdone\n\tif [ -f docs/index.html ]; then \\\n\t\t$(INSTALL_DIR) $(DEST_DIR)$(DOCDIR)/css; \\\n\t\t$(INSTALL_DIR) $(DEST_DIR)$(DOCDIR)/images; \\\n\t\t$(INSTALL) docs/css/asciidoc.css $(DEST_DIR)$(DOCDIR)/css; \\\n\t\t$(INSTALL) docs/css/docs-offline.css $(DEST_DIR)$(DOCDIR)/css; \\\n\t\t$(INSTALL) docs/images/favicon.ico $(DEST_DIR)$(DOCDIR)/images; \\\n\t\t$(INSTALL) docs/images/sunt-200.png $(DEST_DIR)$(DOCDIR)/images; \\\n\tfi\n\n.PHONY: install_examples\ninstall_examples : install_dirs\n\t$(INSTALL_DIR) $(DEST_DIR)$(DOCDIR)/examples\n\t$(INSTALL) examples/BUILD.plz $(DEST_DIR)$(DOCDIR)/examples\n\t$(INSTALL) examples/README.md $(DEST_DIR)$(DOCDIR)/examples\n\t$(INSTALL) examples/hello.p $(DEST_DIR)$(DOCDIR)/examples\n\t$(INSTALL) examples/fib.p $(DEST_DIR)$(DOCDIR)/examples\n\t$(INSTALL) examples/module_example.p $(DEST_DIR)$(DOCDIR)/examples\n\t$(INSTALL) examples/module_to_import.p $(DEST_DIR)$(DOCDIR)/examples\n\t$(INSTALL) examples/mr4.p $(DEST_DIR)$(DOCDIR)/examples\n\t$(INSTALL) examples/temperature.p $(DEST_DIR)$(DOCDIR)/examples\n\n# .mer_progs must be real and not a phony target to make this work with\n# make -j\nsrc/plzasm : .mer_progs\n\ttouch src/plzasm\nsrc/plzbuild : .mer_progs\n\ttouch src/plzbuild\nsrc/plzc : .mer_progs\n\ttouch src/plzc\nsrc/plzdisasm : .mer_progs\n\ttouch src/plzdisasm\nsrc/plzgeninit : .mer_progs\n\ttouch src/plzgeninit\nsrc/plzlnk : .mer_progs \n\ttouch src/plzlnk\n.mer_progs : $(MERCURY_SOURCES) runtime/pz_config.h $(C_HEADERS)\n\trm -f src/*.err\n\t(cd src; $(MMC_MAKE) --cflags=\"$(C_CXX_FLAGS_BASE)\" $(MCFLAGS) plzasm)\n\t(cd src; $(MMC_MAKE) --cflags=\"$(C_CXX_FLAGS_BASE)\" $(MCFLAGS) plzbuild)\n\t(cd src; $(MMC_MAKE) --cflags=\"$(C_CXX_FLAGS_BASE)\" $(MCFLAGS) plzc)\n\t(cd src; $(MMC_MAKE) --cflags=\"$(C_CXX_FLAGS_BASE)\" $(MCFLAGS) plzdisasm)\n\t(cd src; $(MMC_MAKE) --cflags=\"$(C_CXX_FLAGS_BASE)\" $(MCFLAGS) plzgeninit)\n\t(cd src; $(MMC_MAKE) --cflags=\"$(C_CXX_FLAGS_BASE)\" $(MCFLAGS) plzlnk)\n\ttouch .mer_progs\n\n# We need -rdynamic here so that the foreign code libraries can resolve\n# symbols in the runtime's executable.\nruntime/plzrun : $(OBJECTS)\n\t$(CXX) $(CFLAGS) -o $@ $^ -ldl -rdynamic\n\n%.o : %.c runtime/pz_config.h\n\t$(CC) $(CFLAGS) -o $@ -c $<\n\tmv -f $(DEPDIR)/$(basename $*).Td $(DEPDIR)/$(basename $*).d\n\n%.o : %.cpp runtime/pz_config.h\n\t$(CXX) $(CXXFLAGS) -o $@ -c $<\n\tmv -f $(DEPDIR)/$(basename $*).Td $(DEPDIR)/$(basename $*).d\n\nruntime/pz_config.h : runtime/pz_config.h.in defaults.mk build.mk\n\tsed -e 's/@VERSION@/${VERSION}/' < $< > $@\n\n$(DEPDIR)/%.d : ;\n.PRECIOUS: $(DEPDIR)/%.d\n\n.PHONY: test\ntest : test-old test-new\n\n.PHONY: test-old\ntest-old : src/plzasm src/plzlnk src/plzc src/plzbuild runtime/plzrun\n\t(cd tests-old; ./run_tests.sh $(BUILD_TYPE))\n.PHONY: test-new\ntest-new : src/plzasm src/plzlnk src/plzc src/plzbuild runtime/plzrun\n\tBUILD_TYPE=$(BUILD_TYPE) ./tests/run-tests.lua examples tests | ./tests/pretty.lua\n\n.PHONY: tags\ntags : src/tags runtime/tags\nsrc/tags : $(MERCURY_SOURCES)\n\t(cd src; mtags *.m)\nruntime/tags: $(CXX_SOURCES) $(C_HEADERS)\n\t(cd runtime; ctags *.cpp *.h)\n\n.PHONY: docs\ndocs : $(DOCS_TARGETS)\n\n.docs_warning :\n\t@echo\n\t@echo Warning: $(ASCIIDOC) not found, not building documentation.\n\t@echo --------------------------------------------------------\n\t@echo\n\ttouch .docs_warning\n\n%.html : %.txt docs/asciidoc.conf\n\t$(ASCIIDOC) --conf-file docs/asciidoc.conf -o $@ $<\n\n#\n# Clean removes all intermediate files\n#\n.PHONY: clean\nclean : localclean\n\t$(MAKE) -C examples clean\n\t$(MAKE) -C tests-old/pzt clean\n\t$(MAKE) -C tests-old/modules clean\n\t$(MAKE) -C tests-old/modules-invalid clean\n\tfind tests -name *.pz -o \\\n\t\t\t -name *.pzo -o \\\n\t\t\t -name *.pi -o \\\n\t\t\t -name *.out -o \\\n\t\t\t -name *.outs -o \\\n\t\t\t -name *.so \\\n\t\t| xargs -r rm\n\tfind tests -name _build -o \\\n\t\t\t -name \\*.dir \\\n\t\t| xargs -r rm -r\n\n#\n# Realclean removes all generated files plus plasma-dump files.\n#\n.PHONY: realclean\nrealclean : localclean\n\t$(MAKE) -C examples realclean\n\t$(MAKE) -C tests-old/pzt realclean\n\t$(MAKE) -C tests-old/modules realclean\n\t$(MAKE) -C tests-old/modules-invalid realclean\n\trm -f src/tags \n\trm -f src/plzasm src/plzbuild src/plzc src/plzdisasm src/plzgeninit \\\n\t\tsrc/plzlnk\n\trm -rf src/Mercury\n\trm -f .mer_progs\n\trm -rf runtime/tags runtime/plzrun\n\trm -rf $(DOCS_HTML)\n\n.PHONY: localclean\nlocalclean:\n\tfor dir in \\\n\t\tdate0s \\\n\t\tdate3s \\\n\t\tdates \\\n\t\terr_dates \\\n\t\tint0s \\\n\t\tint2s \\\n\t\tint3s \\\n\t\tints \\\n\t\tmodule_deps ; \\\n\tdo \\\n\t\trm -rf src/Mercury/$$dir; \\\n\tdone\n\tfor dir in cs os c_dates ; do \\\n\t\trm -rf src/Mercury/*/*/Mercury/$$dir; \\\n\tdone\n\trm -rf src/*.err src/*.mh\n\trm -rf runtime/*.o runtime/pz_config.h\n\trm -rf examples/*.pz examples/*.diff examples/*.out\n\trm -rf .docs_warning\n\trm -rf $(DEPDIR)\n\n# Nither formatting tool does a perfect job, but clang-format seems to be\n# the best.\n.PHONY: format\nformat: formatclangformat\n\n.PHONY: formatclangformat\nformatclangformat:\n\t$(CLANGFORMAT) -style=file -i $(C_SOURCES) $(CXX_SOURCES) $(C_HEADERS)\n\ninclude $(wildcard $(patsubst %,$(DEPDIR)/%.d,$(basename $(C_CXX_SOURCES))))\n\n" }, { "path": "README.md", "content": "# Plasma Language\n## *a new programming language*\n\nPlasma is a new programming language for safe and efficient general purpose\nuse.\nIt is a statically typed, side-effect free single assignment language\nand will have functional programming and concurrent programming features.\nIt will support deterministic parallel execution.\nFor a general overview, please visit\n[https://plasmalang.org/](https://plasmalang.org/)\nIt is in early development.\n\nIt is free software, Copyright (C) 2015-2025 The Plasma Team, distributed\nmostly under the MIT license, see [LICENSE](LICENSE) for details.\n\n![CI](https://github.com/PlasmaLang/plasma/workflows/CI/badge.svg)\n\n## Getting started\n\nThis README.md contains some quick info for getting started.\nFor more complete info please see our\n[getting started guide](https://plasmalang.org/docs/getting_started.html).\n\n### Dependencies\n\nPlasma has been tested on Linux, Windows subsystem for Linux 1 and 2 on\nx86\\_64.\n\nYou will need:\n\n* A C compiler (C99 on a POSIX.1-2008 environment), I've been testing with\n GCC. Clang should also work.\n* GNU Make\n* [Mercury](https://www.mercurylang.org/).\n A recent stable version is required (22.01.x).\n Plasma's CI currently tests with 22.01.\n* The [ninja build system](https://ninja-build.org), at least version 1.10.\n\nOptionally to build the documentation you will also need:\n* asciidoc\n* source-highlight\n\nOptionally to run the test suite you will also need:\n* lua\n* lua-file-system\n* lua-posix\n* lua-curses\n* diffutils\n* ncurses\n\nOn Debian (also Ubuntu, Mint etc) Linux\n\n $ apt install build-essential ninja-build lua5.3 lua-filesystem lua-posix diffutils asciidoc source-highlight ncurses-bin\n\nWill get you started, then proceed to installing Mercury below.\n\n### Mercury installation\n\nThe easiest way to install Mercury is to install the\n[.deb packages](https://dl.mercurylang.org/deb/) (on Debian, Ubuntu, etc).\n\nOtherwise download Mercury's [source package](https://dl.mercurylang.org)\nand follow the\ninstallation instructions in the\n[INSTALL](https://github.com/Mercury-Language/mercury/blob/master/.INSTALL.in)\nfile.\nWe've made some\n[notes about grades](https://plasmalang.org/docs/grades.html)\nthat may help with choosing which grades you may need.\nThere is also a\n[README.bootstrap](https://github.com/Mercury-Language/mercury/blob/master/README.bootstrap)\nfile with Mercury bootstrapping information if you wish to do that, it may\nalso provide some additional explaination.\n\n### Usage\n\nCopy `template.mk` to `build.mk` and edit it to make any build configuration\nchanges you need.\n\nUse ```make``` in the root directory to build the project.\nThen ```make install`` to install the tools into ```$PREFIX/bin```.\n\nThis compiles and installs the following programs. Make sure they're in\nyour ```PATH```.\n\n* src/plzc - The plasma compiler, compiles plasma (```.p```) files to\n plasma modules (```.pzo```)\n* src/plzlnk - The plasma linker, links one more more modules (```.pzo```)\n into a plasma program (```.pz```)\n* src/plzbuild - The plasma build system\n* runtime/plzrun - The runtime system, executes plasma programs (```.pz```).\n* src/plzasm - The plasma bytecode assembler. This compiles textual bytecode\n (```.pzt```) to bytecode (```.pzo```). It is useful for testing the\n runtime.\n\nThere are example plasma programs in ```examples/```. Running ```plzbuild```\nin ```examples/``` will build them.\nEach program's bytecode is copied to a file in ```examples/``` eg\n```hello.pz```, run them with ```plzrun ```.\n\n### Layout\n\n* [docs](docs) - Documentation\n* [examples](examples) - Example Plasma programs\n* [runtime](runtime) - Runtime system (C code)\n* [scripts](scripts) - Some scripts to aid developers\n* [src](src) - The compiler and other tools\n* [tests](tests) - The test suite (in addition to some of the files in\n [examples](examples))\n\n## Contributing\n\nPlease see [CONTRIBUTING.md](CONTRIBUTING.md) and\n[CODE_OF_CONDUCT.md](CODE_OF_CONDUCT.md).\nFor detailed information including what to work on please see\n[Contributing to Plasma](https://plasmalang.org/docs/contributing.html) in\nour documentation.\n\n## Getting help\n\nIf you're stuck and the [Documentation](https://plasmalang.org/docs/)\ndoesn't contain the answer or clue you need or you're struggling to find it.\nPlease ask for help.\nThe [Contact](https://plasmalang.org/contact.html) page of the website lists\nall the ways you can get in touch.\nIn particular the\n[Plasma Help mailing list](https://plasmalang.org/lists/listinfo/help)\nand\n[Discord server](https://discord.gg/x4g83w7tKh) are the best\nresources for help.\n\nFor bugs or missing information please\n[file a bug](https://github.com/PlasmaLang/plasma/issues/new).\n\n" }, { "path": "SECURITY.md", "content": "# Security Policy\n\n## Supported Versions\n\nThe master branch is currently the only \"supported\" version. In the future\nthere will be stable / development versions with various support lengths.\n\nThe bytecode/runtime is not designed as a secure execution environment. Bad\nbytecode can run arbitrary code / cause crashes.\nFor a secure bytecode/interpreter consider using\n[WebAssembly](https://webassembly.org).\n\n## Reporting a Vulnerability\n\nWrite an e-mail to `bugs@plasmalang.org`. Do not submit a PR or issue, Github does not support \"private\" PRs and they\nshouldn't be used to share information that could lead to users being harmed if shared publicly.\n\n" }, { "path": "THANKS", "content": "\nThanks\n======\n\nPlasma is primarly developed by Paul Bone.\n\nWe would also like to thank the following people for their contributions and\nsupport:\n\nCode contributions by:\n CcxWrk\n Gert Meulyzer\n Jace Benson\n James Barnes\n Jeremy Wright\n Manu Abraham\n rightfold (https://github.com/rightfold)\n\nWebsite contributions by:\n Anne Ogborn\n Slavfox (https://github.com/slavfox)\n Tobin Harding\n\nBrainstorming/checking, discussions and general support:\n Brendan Zabarauskas\n Emily McDonough (AlaskanEmily)\n Gert Meulyzer\n Michael Richter\n\n" }, { "path": "defaults.mk", "content": "#\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# vim: noet sw=4 ts=4 ft=make\n#\n\n# Where programs are installed\nPREFIX=/usr/local\nBINDIR=$(PREFIX)/bin\nDOCDIR=$(PREFIX)/share/doc/plasma\nVERSION=dev\n\n# The number of parallel jobs the Mercury compiler should spawn.\nJOBS=$(shell if X=$$(nproc 2>&1); then echo $$X; else echo 1; fi)\n\n# How the Mercury compiler should be called. You may need to adjust this if\n# it is not in your path.\nMMC_MAKE=mmc --make -j$(JOBS) --use-grade-subdirs\n\n# How the C compiler should be called. gcc and clang should both work.\n# Note that Mercury has its own configuration for its C backend, which is\n# not, and must not be changed here.\n# Note also that we'd normally define _DEFAULT_SOURCE once in\n# C_CXX_FLAGS_BASE, but Mercury also defines this so we avoid a warning by\n# listing it twice for C_ONLY then CXX_ONLY.\nCC=gcc\nCXX=g++\nC_CXX_FLAGS_BASE=-D_POSIX_C_SOURCE=200809L\nC_ONLY_FLAGS=-std=c99 -D_DEFAULT_SOURCE\nCXX_ONLY_FLAGS=-std=c++11 -fno-rtti -fno-exceptions -D_DEFAULT_SOURCE\nMCFLAGS=\n\n# gcc and probably clang support dependency tracking. If your compiler\n# doesn't uncomment the 2nd line.\nDEPDIR=.dep\nDEPFLAGS=-MT $@ -MMD -MP -MF $(DEPDIR)/$(basename $*).Td\n\n# How to install programs, specify here the owner, group and mode of\n# installed files.\nINSTALL=install\nINSTALL_STRIP=install -s\nINSTALL_DIR=install -d\n\n# How to call asciidoc (optional). A full path or any flags here won't work\n# without other changes to the makefile.\nASCIIDOC=asciidoc\n\n# How to call clang-format (optional)\nCLANGFORMAT=clang-format-10\n\n# This base configuration works on Linux but you may need to change them for\n# other systems / compilers.\nC_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O1 -Wall\nBUILD_TYPE=rel\n\n# This is a suitable build for development. It has assertions enabled in\n# the C code some of which are slow, so they shouldn't be used for\n# performance measurement. Comment it out to use one of the optimised\n# builds below.\n#\n# Note to maintainers: When Plasma is actually \"used\" we should change this\n# default and provide a better way for developers to setup a \"dev\" build\n# with assertions and other checks.\n\n# Development build options\nMCFLAGS+=--warn-dead-procs\nC_CXX_FLAGS+=-Werror -DDEBUG -DPZ_DEV\nBUILD_TYPE=dev\n\n" }, { "path": "docs/.gitignore", "content": "*.html\n" }, { "path": "docs/README.md", "content": "Documentation\n=============\n\nWe're assuming you are running Linux. For Mac it will probably be similar. Since Plasma is currently not supported on Windows, building the docs on that platform is also not documented.\n\nYou will need a working copy of AsciiDoc on your PC to build the documentation.\nFor Ubuntu, it is simply a matter of typing\n\n```shell\nsudo apt-get install asciidoc source-highlight\n```\n\nFor Fedora: \n\n```shell\nsudo dnf install asciidoc\n```\n\nFor other distros, check your package manager.\n\nYou also need to install [source-highlight](https://www.gnu.org/software/src-highlite/source-highlight.html) to get the C code properly highlighted. Your package manager should also have this.\n\nWith these installed, you should be set.\n\nTo build the documentation type ``make docs`` in the project's top-level\ndirectory. This will generate the HTML output.\n\n" }, { "path": "docs/asciidoc.conf", "content": "[attributes]\nlinkcss=yes\nbackend=html5\n\n[header]\n\n\n\n\n\n\n\n\n\n\nPlasma Programming Language: {doctitle}\n\n\n\n\n\n{docinfo1,docinfo2#}{include:{docdir}/docinfo.html}\n{docinfo,docinfo2#}{include:{docdir}/{docname}-docinfo.html}\n\n\n
\n

\"sunPLASMA

\n
\n
\n\n
\n\n
\n

{doctitle}

\n\n{copyright}
Distributed under {license}
\nUpdated: {revdate}\n{toc,toc2#}{toc-placement$auto:}{template:toc}\n
\n\n[footer]\n{disable-javascript%
}\n
\n
\n\n\n\n" }, { "path": "docs/contributing.txt", "content": "Contributing to Plasma\n======================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: September, 2022\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nThis file contains information for potential and current Plasma\ncontributors.\n\n== Summary and legal stuff\n\n* We prefer github pull requests or patches mailed to the\n https://plasmalang.org/lists/listinfo/dev[developers' mailing list].\n If you need to discuss a security issue confidently you can e-mail\n plasma at plasmalang dot org\n* The license of your contribution must match the project's licenses:\n** Code: MIT\n** Docs: CC BY-SA 4.0\n** Build scripts, tests, and sample code: Unlicense\n* No contributor agreement is required, you retain the copyright for your\n contribution.\n* Please follow the style guides as much as possible (see below)\n* Please format your log messages following the log message style (see\n below)\n* By opening a PR you acknowledge these terms and agree to the\n https://github.com/PlasmaLang/plasma/blob/master/CODE_OF_CONDUCT.md[Code\n of Conduct].\n* By opening an issue or adding a comment or message you also agree to the \n https://github.com/PlasmaLang/plasma/blob/master/CODE_OF_CONDUCT.md[Code\n of Conduct].\n\n== Getting started\n\nFor information on how to setup the dependencies and compile Plasma the best\nplace to start is the link:getting_started.html[Getting Started] Guide.\n\n=== vim\n\nIf you'll be working on the compiler you probably want some editor support\nfor Mercury. Support is included in the \nhttps://github.com/Mercury-Language/mercury/tree/master/vim[Mercury\nrepository]/source distribution\nif you've used the Debian package it's at\n`/usr/share/doc/mercury-rotd-tools/examples/vim/`\n\nYou may also wish to use the\nhttps://github.com/PlasmaLang/plasma/tree/master/scripts[extra script]\nand configuration change to make it easier to build the Mercury sources from\nwithin vim.\n\n== What to contribute\n\nYou want to contribute but aren't sure what you'd like to work on?\n\nThe most valuable contributions will fit with Plasma's\nhttps://plasmalang.org/about.html[goals] and current development status\n(https://plasmalang.org/roadmap.html[project roadmap]).\nThe project is at an early stage and therefore we are prioritising work that\nmakes the language useful above things like compiler optimisations.\n\n=== Suggestions and good first bugs\n\nIf you're looking for a suggestion of what to contribute\nplease consider the\nhttps://github.com/PlasmaLang/plasma/issues?q=is%3Aopen+is%3Aissue+no%3Aassignee[open unassigned github issues]\n\nWe label our issues within github to help searchability but also to provide\nsome ideas about what is involved with each issue.\nSome issues have the\nhttps://github.com/PlasmaLang/plasma/issues?q=is%3Aopen+is%3Aissue+no%3Aassignee+label%3A%22meta%3A+good-first-bug%22[good-first-bug] label.\nThese tend to be really small changes that require relatively little\nexperience to complete.\nThey should take someone with a year of programming experience no more than\n2 hours, usually much less.\nThey might not be suitable for someone in their first month or two of\nprogramming.\nThe\nhttps://github.com/PlasmaLang/plasma/issues?utf8=%E2%9C%93&q=is%3Aopen+is%3Aissue+no%3Aassignee+label%3A%22meta%3A+no-domain-knowledge%22+[no-domain-knowledge]\nlabel contains more difficult changes.\nThese may require a fair amount of programming experience but they do\nnot require any programming language implementation experience,\nor otherwise have very clear help.\n\nOther labels can indicate what component they are relevant to, for example:\n'component: docs' or 'component: compiler'.\nOr what skills may be required 'skill: C++'.\nThere is also a\nhttps://github.com/PlasmaLang/plasma/issues?q=is%3Aopen+is%3Aissue+label%3A%22meta%3A+help+wanted%22[help wanted]\nlabel for anything where people already involved with the project might not\nhave the skills we think are required.\n\nIf you file a new bug, do not worry about adding labels, a project maintainer\nwill follow link:bugtracking.html[this guide] to triage it.\n\nThere are also many `TODO` and `XXX` notes in the source code, which things\nthat are not handled. Search for the strings `TODO` and `XXX`. Keep in\nmind that there may be good reasons why these are not yet handled, eg: it\nmay depend on other incomplete work.\n\nIf you find something undocumented whose behaviour is unlikely to change,\nconsider filling in that part of the documentation.\n\nWhen reading code if something isn't clear, please ask us about it. We'll\nalso take this as a hint that we should have written (better) code comments\nor docs.\n\n=== Get in contact\n\nIf you've got a big idea it's often good to\nhttps://plasmalang.org/lists/listinfo/dev[discuss it with us]\nbefore starting.\nWe may be able to give you some pointers or let you know what kinds of\nproblems you may encounter.\nFor example we might not be interested n making the language weakly typed\nand discussing this beforehand may avoid disappointment later.\nUltimately we want you to enjoy working with Plasma and that means making\nthe most of your development time.\n\n== How to contribute\n\nWe want to build a great language and we also want you/us to have a good time\nbuilding a great language. These guidelines will make it easier for us to\nreview and maintain your code, and hopefully for you to have a better\nexperience during code-review.\n\n=== Before beginning\n\nIt is best to start each piece of work on a new git branch. Create a branch\noff of master and commit your changes there as you go.\n\nOpen/comment on/assign yourself on an issue. Let us know what you want to\nwork as part of github's issue tracking (see above). We can add you to the\nPlasma project so that you can be assigned to an issue, then we know who is\nworking on it.\n\n=== Making your changes\n\nIf you're making a series of patches, try to organise the patches so that\neach patch makes sense on its own. Git has many features for doing this\nincluding cherry picking and rebasing.\n\nCode contributions should follow the style guides as much as possible.\nDeviations that make code more readable are permitted.\nThe guides are\nhttps://plasmalang.org/docs/Mercury_style.html[Mercury style guide]\nand\nhttps://plasmalang.org/docs/C_style.html[C style guide].\n\nTODO: Provide information about project structure.\n\nSpell check and test your work, use +make test+ for the latter. Each patch\nshould, when applied in series, pass the test suite.\n\n=== Documenting your changes\n\nUser-visible changes including new options, features and behaviours should be\ndocumented. For now options are documented in the `--help` text of each\nprogram. While designs and concepts are documented in one of the files in\nthe docs directory, these files are asciidoc text files.\n\n=== Submitting your changes\n\nAll code contributions must be made under the appropriate license:\n\n* Code: MIT\n* Docs: CC BY-SA 4.0\n* Build scripts, tests, and sample code: Unlicense\n\nNo transfer of copyright or other rights or permissions is required.\n\nLog messages should follow the style:\n\n [component(s)] Title\n\n Description\n\n Any other changes including changes that were needed to support this\n change or followed as a concequence of this change.\n\nWe provide a +.gitmessage+ in the root of the repository.\nRun this command to start using the new commit message template:\n\n git config --local commit.template /path/to/repo/.gitmessage\n\n_components_ is one or more parts of the system. This helps people\nidentify (in mailing lists, change logs etc) what kind of change has been\nmade at a glace. It also helps people and software search for changes.\nCurrent components are:\n\n* *pz*: the PZ file format,\n* *rt*: the runtime generally,\n* *rt/interp*: the bytecode interpreter,\n* *rt/gc*: the garbage collector,\n* *asm*: the PZ assembler,\n* *compiler*: the compiler generally,\n* *compiler/parse*: the first phase: parsing.\n* *compiler/ast*: the second phase: the AST and operations on it,\n* *compiler/pre*: the third phase: the pre-core representation and operations,\n* *compiler/core*: the fourth phase: the core representation and operations,\n* *compiler/pz*: the fitht phase: the PZ code generator,\n* *compiler/util*: other utility code in the compiler, \n* *build*: the build system,\n* *docs*: documentation,\n* *scripts*: the build system and other scripts,\n* *tests*: the test suite,\n\nSometimes it makes sense to pick the component with the most significant\nchanges rather than listing all of them. This is typical for changes to the\ncompiler.\n\nEach patch should contain a single change and changes required by that\nchange (should compile and pass tests). Changes may be rolled together when\nthey're trivial related changes (eg, multiple spelling fixes).\n\nAlso, not a real component:\n\n* *merge*: for merge commits (See the link:maintainers.html[Maintainer's\n guide])\n\nWe accept contributions via pull request on github, or via e-mailed patches.\nIf you choose to use e-mailed patches then the +git format-patchi+ and/or\n+git send-email+ tools can generate nice e-mails, however\nthis is not required, +diff -uNr+ is sufficient.\nE-mailed patches should be sent to the\nhttps://www.plasmalang.org/lists/listinfo/dev[dev] mailing list.\n\nTODO: Provide suitable step-by-step instructions.\n\n=== Our review policy\n\nWe aim to act on your changes reasonably quickly. However this is something\npeople do in their spare time, they may be busy with other aspects of their\nlives and not reply for several days. We will provide feedback and guidance\nwhere applicable. We want you to enjoy working with Plasma and that means\nwe will try to help you make the most of your development time.\n\nA reviewer accepting your code will ask themselves \"Does this change make\nPlasma better?\" if the answer is yes and you're a first time contributor,\nthey'll click the merge button and might follow-up with some further changes\nof their own (eg for style). If you're more experienced they'll be a\ngreater expectation on you to confirm to style and cover edge cases.\n\n== Further documentation\n\nDocumentation on specific topics of interest to Plasma implementors can be\nfound here.\n\nlink:dev_howto_make_pr.html[How to make a pull request]\n\nlink:dev_compiler_internals.html[Compiler structure/internals]\n\nlink:dev_testing.html[Plasma test suite]\n\nlink:dev_style_mercury.html[Mercury style guide]\n\nlink:dev_style_c.html[C and C++ style guide]\n\nlink:dev_mercury_grades.html[Mercury grades]\n\nFor maintainers:\n\nlink:dev_maintainers.html[Plasma maintainer's guide]\n\nlink:dev_bugtracking.html[Bugtracking]\n\nLanguage design:\n\nlink:design_principles.html[Language design principles]\n\nlink:design_concept_map.html[Plasma Syntax to Concept Map]\n\nlink:design_types.html[Type System Design]\n\nlink:design_ideas.html[Ideas for Plasma]\n\nlink:references.html[References and Links]\n\nPlasma bytecode and abstract machine (PZ):\n\nlink:pz_machine.html[Plasma Abstract Machine]\n\nhttps://github.com/PlasmaLang/plasma/blob/master/runtime/pz_format.h[Plasma Bytecode Format]\n\n== Getting help\n\nIf you're stuck and the https://plasmalang.org/docs/[Documentation] doesn't\ncontain the answer or clue you need, or you're struggling to find it.\nPlease ask for help.\nThe https://plasmalang.org/contact.html[Contact] page of the website lists\nall the ways you can get in touch.\nIn particular the\nhttps://plasmalang.org/lists/listinfo/help[Plasma Help mailing list]\nand\nhttps://discord.gg/x4g83w7tKh[Discord server] are the best\nresources for help.\n\nFor bugs or missing information please\nhttps://github.com/PlasmaLang/plasma/issues/new[file a bug].\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/css/asciidoc.css", "content": "/* Shared CSS for AsciiDoc xhtml11 and html5 backends */\n/* Copyright (C) 2000-2007 Stuart Rackham */\n/* Copyright (C) Plasma Team (adapted for plasmalang.org) */\n/* License: GPL2 or later */\n\n/* Default font. */\nbody {\n font-family: Georgia,serif;\n}\n\n.content h1, .content h2, .content h3 {\n border-bottom: 2px solid silver;\n}\nh2 {\n padding-top: 0.5em;\n}\nh3 {\n float: left;\n}\nh3 + * {\n clear: left;\n}\nh5 {\n font-size: 1.0em;\n}\n\n.monospaced, code, pre {\n font-family: \"Courier New\", Courier, monospace;\n font-size: inherit;\n color: navy;\n padding: 0;\n margin: 0;\n}\npre {\n white-space: pre-wrap;\n}\n\n#author {\n font-weight: bold;\n font-size: 1.1em;\n}\n#email {\n}\n#revnumber, #revdate, #revremark {\n}\n\n#footer {\n font-size: small;\n border-top: 2px solid silver;\n padding-top: 0.5em;\n margin-top: 4.0em;\n}\n#footer-text {\n float: left;\n padding-bottom: 0.5em;\n}\n#footer-badges {\n float: right;\n padding-bottom: 0.5em;\n}\n\n#preamble {\n margin-top: 1.5em;\n margin-bottom: 1.5em;\n}\ndiv.imageblock, div.exampleblock, div.verseblock,\ndiv.quoteblock, div.literalblock, div.listingblock, div.sidebarblock,\ndiv.admonitionblock {\n margin-top: 1.0em;\n margin-bottom: 1.5em;\n}\ndiv.admonitionblock {\n margin-top: 2.0em;\n margin-bottom: 2.0em;\n margin-right: 10%;\n color: #606060;\n}\n\n/* Block element titles. */\ndiv.title, caption.title {\n font-weight: bold;\n text-align: left;\n margin-top: 1.0em;\n margin-bottom: 0.5em;\n}\ndiv.title + * {\n margin-top: 0;\n}\n\ntd div.title:first-child {\n margin-top: 0.0em;\n}\ndiv.content div.title:first-child {\n margin-top: 0.0em;\n}\ndiv.content + div.title {\n margin-top: 0.0em;\n}\n\ndiv.sidebarblock > div.content {\n background: #ffffee;\n border: 1px solid #dddddd;\n border-left: 4px solid #f0f0f0;\n padding: 0.5em;\n}\n\ndiv.listingblock > div.content {\n border: 1px solid #dddddd;\n border-left: 5px solid #f0f0f0;\n background: #f8f8f8;\n padding: 0.5em;\n}\n\ndiv.quoteblock, div.verseblock {\n padding-left: 1.0em;\n margin-left: 1.0em;\n margin-right: 10%;\n border-left: 5px solid #f0f0f0;\n color: #888;\n}\n\ndiv.quoteblock > div.attribution {\n padding-top: 0.5em;\n text-align: right;\n}\n\ndiv.verseblock > pre.content {\n font-family: inherit;\n font-size: inherit;\n}\ndiv.verseblock > div.attribution {\n padding-top: 0.75em;\n text-align: left;\n}\n/* DEPRECATED: Pre version 8.2.7 verse style literal block. */\ndiv.verseblock + div.attribution {\n text-align: left;\n}\n\ndiv.admonitionblock .icon {\n vertical-align: top;\n font-size: 1.1em;\n font-weight: bold;\n text-decoration: underline;\n padding-right: 0.5em;\n}\ndiv.admonitionblock td.content {\n padding-left: 0.5em;\n border-left: 3px solid #dddddd;\n}\n\ndiv.exampleblock > div.content {\n border-left: 3px solid #dddddd;\n padding-left: 0.5em;\n}\n\ndiv.imageblock div.content { padding-left: 0; }\nspan.image img { border-style: none; vertical-align: text-bottom; }\na.image:visited { color: white; }\n\ndl {\n margin-top: 0.8em;\n margin-bottom: 0.8em;\n}\ndt {\n margin-top: 0.5em;\n margin-bottom: 0;\n font-style: normal;\n}\ndd > *:first-child {\n margin-top: 0.1em;\n}\n\nul, ol {\n list-style-position: outside;\n}\nol.arabic {\n list-style-type: decimal;\n}\nol.loweralpha {\n list-style-type: lower-alpha;\n}\nol.upperalpha {\n list-style-type: upper-alpha;\n}\nol.lowerroman {\n list-style-type: lower-roman;\n}\nol.upperroman {\n list-style-type: upper-roman;\n}\n\ndiv.compact ul, div.compact ol,\ndiv.compact p, div.compact p,\ndiv.compact div, div.compact div {\n margin-top: 0.1em;\n margin-bottom: 0.1em;\n}\n\ntfoot {\n font-weight: bold;\n}\ntd > div.verse {\n white-space: pre;\n}\n\ndiv.hdlist {\n margin-top: 0.8em;\n margin-bottom: 0.8em;\n}\ndiv.hdlist tr {\n padding-bottom: 15px;\n}\ndt.hdlist1.strong, td.hdlist1.strong {\n font-weight: bold;\n}\ntd.hdlist1 {\n vertical-align: top;\n font-style: normal;\n padding-right: 0.8em;\n color: navy;\n}\ntd.hdlist2 {\n vertical-align: top;\n}\ndiv.hdlist.compact tr {\n margin: 0;\n padding-bottom: 0;\n}\n\n.comment {\n background: yellow;\n}\n\n.footnote, .footnoteref {\n font-size: 0.8em;\n}\n\nspan.footnote, span.footnoteref {\n vertical-align: super;\n}\n\n#footnotes {\n margin: 20px 0 20px 0;\n padding: 7px 0 0 0;\n}\n\n#footnotes div.footnote {\n margin: 0 0 5px 0;\n}\n\n#footnotes hr {\n border: none;\n border-top: 1px solid silver;\n height: 1px;\n text-align: left;\n margin-left: 0;\n width: 20%;\n min-width: 100px;\n}\n\ndiv.colist td {\n padding-right: 0.5em;\n padding-bottom: 0.3em;\n vertical-align: top;\n}\ndiv.colist td img {\n margin-top: 0.3em;\n}\n\n@media print {\n #footer-badges { display: none; }\n}\n\n#toc {\n margin-bottom: 2.5em;\n}\n\n#toctitle {\n font-size: 1.1em;\n font-weight: bold;\n margin-top: 1.0em;\n margin-bottom: 0.1em;\n}\n\ndiv.toclevel0, div.toclevel1, div.toclevel2, div.toclevel3, div.toclevel4 {\n margin-top: 0;\n margin-bottom: 0;\n}\ndiv.toclevel2 {\n margin-left: 2em;\n font-size: 0.9em;\n}\ndiv.toclevel3 {\n margin-left: 4em;\n font-size: 0.9em;\n}\ndiv.toclevel4 {\n margin-left: 6em;\n font-size: 0.9em;\n}\n\nspan.aqua { color: aqua; }\nspan.black { color: black; }\nspan.blue { color: blue; }\nspan.fuchsia { color: fuchsia; }\nspan.gray { color: gray; }\nspan.green { color: green; }\nspan.lime { color: lime; }\nspan.maroon { color: maroon; }\nspan.navy { color: navy; }\nspan.olive { color: olive; }\nspan.purple { color: purple; }\nspan.red { color: red; }\nspan.silver { color: silver; }\nspan.teal { color: teal; }\nspan.white { color: white; }\nspan.yellow { color: yellow; }\n\nspan.aqua-background { background: aqua; }\nspan.black-background { background: black; }\nspan.blue-background { background: blue; }\nspan.fuchsia-background { background: fuchsia; }\nspan.gray-background { background: gray; }\nspan.green-background { background: green; }\nspan.lime-background { background: lime; }\nspan.maroon-background { background: maroon; }\nspan.navy-background { background: navy; }\nspan.olive-background { background: olive; }\nspan.purple-background { background: purple; }\nspan.red-background { background: red; }\nspan.silver-background { background: silver; }\nspan.teal-background { background: teal; }\nspan.white-background { background: white; }\nspan.yellow-background { background: yellow; }\n\nspan.big { font-size: 2em; }\nspan.small { font-size: 0.6em; }\n\nspan.underline { text-decoration: underline; }\nspan.overline { text-decoration: overline; }\nspan.line-through { text-decoration: line-through; }\n\ndiv.unbreakable { page-break-inside: avoid; }\n\n\n/*\n * html5 specific\n *\n * */\n\ntable.tableblock {\n margin-top: 1.0em;\n margin-bottom: 1.5em;\n}\nthead, p.tableblock.header {\n font-weight: bold;\n color: #527bbd;\n}\np.tableblock {\n margin-top: 0;\n}\ntable.tableblock {\n border-width: 3px;\n border-spacing: 0px;\n border-style: solid;\n border-collapse: collapse;\n}\nth.tableblock, td.tableblock {\n border-width: 1px;\n padding: 4px;\n border-style: solid;\n}\n\ntable.tableblock.frame-topbot {\n border-left-style: hidden;\n border-right-style: hidden;\n}\ntable.tableblock.frame-sides {\n border-top-style: hidden;\n border-bottom-style: hidden;\n}\ntable.tableblock.frame-none {\n border-style: hidden;\n}\n\nth.tableblock.halign-left, td.tableblock.halign-left {\n text-align: left;\n}\nth.tableblock.halign-center, td.tableblock.halign-center {\n text-align: center;\n}\nth.tableblock.halign-right, td.tableblock.halign-right {\n text-align: right;\n}\n\nth.tableblock.valign-top, td.tableblock.valign-top {\n vertical-align: top;\n}\nth.tableblock.valign-middle, td.tableblock.valign-middle {\n vertical-align: middle;\n}\nth.tableblock.valign-bottom, td.tableblock.valign-bottom {\n vertical-align: bottom;\n}\n\n\n" }, { "path": "docs/css/docs-offline.css", "content": "/*\n * Copyright (C) Plasma Team \n * Licensed as CC BY-NC-ND 4.0\n */\n@import url(https://fonts.googleapis.com/css?family=Source+Code+Pro:400,700|Roboto:400,400italic,700,700italic);\n\nbody {\n font-family: Roboto, Arial, Sans-serif;\n margin: 0px;\n font-size: 14pt;\n}\n\n.content, div.banner h1, div.menu ul {\n margin: 0px auto;\n width: 90%;\n max-width: 900px;\n}\n@media screen and (max-width: 360px) {\n h1 {\n text-align: center;\n }\n}\n@media screen and (max-width: 800px) {\n #hardwork {\n display: none;\n }\n}\n\ndiv.banner h1 {\n font-weight: bold;\n margin-top: 0px;\n margin-bottom: 0px;\n padding-top: 16px;\n padding-bottom: 16px;\n font-size: 48pt;\n}\ndiv.banner h1 img {\n vertical-align: bottom;\n}\n\ndiv.banner {\n background: black;\n color: yellow;\n}\n\ndiv.menu {\n background: black;\n /* border-top: 2px solid red;\n border-bottom: 2px solid red; */\n padding-bottom: 16px;\n}\ndiv.menu-gap {\n height: 48px;\n background: -webkit-linear-gradient(black, white); /* Safari 5.1 to 6.0 */\n background: -o-linear-gradient(black, white); /* Opera 11.1 to 12.0 */\n background: -moz-linear-gradient(black white); /* Firefox 3.6 to 15 */\n background: linear-gradient(black, white) grey;\n background-repeat: no-repeat; /* fix for prince & okular */\n}\ndiv.menu ul {\n padding-left: 0px;\n}\ndiv.menu ul li {\n display: inline-block;\n padding: 0.2em;\n font-size: 110%;\n color: yellow;\n}\ndiv.menu ul li a {\n color: yellow;\n text-decoration: none;\n}\n\ndiv.content {\n margin-top: 24px;\n}\n\ndiv.figure {\n float: right;\n border: 1px solid black;\n margin: 10px;\n}\n\ndiv.figure p.caption {\n margin: 10px;\n} \n\ndt {\n margin-bottom: 0.5em;\n font-style: italic;\n}\ndd {\n margin-bottom: 1em;\n}\n\nol.milestones li ul {\n list-style-type: none;\n}\nol.milestones li ul li:before {\n margin-left: -40px;\n width: 40px;\n text-align: center;\n display: inline-block;\n background-repeat: no-repeat;\n background-position: center;\n margin-top: 1px;\n margin-bottom: -4px;\n height: 21px;\n content: \" \";\n}\nol.milestones li ul li.status-done:before {\n background-image: url(images/icons/done-21.png);\n}\nol.milestones li ul li.status-todo:before {\n background-image: url(images/icons/todo-21.png);\n}\nol.milestones li ul li.status-wip:before {\n background-image: url(images/icons/wip-21.png);\n}\nol.milestones li ul li.status-blocked:before {\n background-image: url(images/icons/blocked-21.png);\n}\n\ncode, pre, .monospaced {\n font-family: 'Source Code Pro', \"Courier New\", Courier, monospace;\n}\n\ntd > p {\n margin-bottom: 0;\n}\n\n" }, { "path": "docs/design_concept_map.txt", "content": "Plasma Syntax to Concept Map\n============================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: April 2017\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nThe purpose of this document is to show for each syntax-ish thing, what the\nunderlying concept is. This should help us design the language on a\ncoherent way. It is not intended as user documentation.\n\n== Brackets\n\n.Brackets\n|===\n|Brackets | Concept(s) | Comment\n\n| +( )+\n| Expression grouping, parameter lists (functions, types & structs)\n| Familiar to many programmers\n\n| +{ }+\n| Code\n|\n\n| +[ ]+\n| Lists (arbitrary size)\n| Lists, for loop parameters (unimplemented), *array indexing*.\n\n| +[- -]+ or +[~ ~]+\n| Streams\n| Future, maybe use the ~ or - to denote whether it's a lazy list or a\n parallel stream (channel).\n\n| +[: :]+\n| Arrays (fixed size sequences)\n|\n\n| +[% %]+ or +[# #]+ or something else?\n| Dictionariies,\n|\n\n|===\n\n== Symbols\n\n.Symbols\n|===\n|Symbol | Concept(s) | Comment\n\n| +//+\n| Comment\n|\n\n| +/\\*+ +*/+\n| Comment\n|\n\n| +_+ (underscore)\n| Wildcard\n| Used instead of variables in patterns, arguments and the LHS of assignments\n\n| +\\*+, +/+, +%+, +++, +\\-+\n| Arithmetic operators\n|\n\n| '-'\n| Unary minus\n| Similar concept as subtraction\n\n| +<+, +>+, +<=+, +>=+, +==+, +!=+\n| Comparison operators\n|\n\n| +and+, +or+, +not+\n| Logical operators\n| Not really \"symbols\" in the character ranges meaning of the word, but\n included here alongside other operators.\n\n| ++\n| Concatenation operator\n|\n\n| +,+\n| Parameter separation\n| in function results, argument lists (functions and types) and field lists,\n loop dot products.\n\n| +*+\n| Wildcard (in import/export lists), Multiplication\n|\n\n| +\\|+\n| \"or\" in structure and type alternatives, \"join\" in lists and other\n structures.\n|\n\n| +&+\n| \"and\" cross product in loop inputs.\n| Future, maybe, \"and\" doesn't mean \"cross\" or \"by\".\n\n| +:+\n| \"has type\"\n|\n\n| +.+\n| Scope qualification (access something from within another scope)\n|\n\n| +\\->+\n| \"results in\"\n| Used to separates a function's return values from its inputs,\n may be used in lambda expressions also.\n\n| +\\<-+\n| \"gets\", different from \"let\"\n| Part of loop syntax, unimplemented.\n\n| +=+\n| \"let\"\n| The LHS (a new variable) is given the value of the RHS (also in struct\n construction and deconstruction).\n Or in type declarations, the type name on the LHS has the set of values\n from the RHS.\n Or in list outputs and reductions (unimplemented).\n In all of these cases the meaning is \"let\".\n\n| +:=+\n| \"store\" or \"write\"\n| The value on the LHS is updated with the RHS, this makes sense for arrays.\n\n| +!+\n| Side-effect\n| added to a function call to indicate that it uses or\n observers a resource.\n\n| +..+\n| \"to\"\n| Future: For ranges, eg in array slicing.\n\n| +\\+\n| \"lambda\"\n| Future\n\n| +$+\n|\n| Future: state variable syntax\n\n| +@+\n| \"at\"\n| Reserved in case I ever want to add pointer manipulation a la PAWNS.\n\n| +#+\n|\n| Unused\n\n| +%+\n|\n| Unused: Maybe string formatting?\n\n|===\n\n== Issues\n\n.Issues\n|===\n|Symbol | Issue\n\n| +[ ]+\n| This usually means a sequence but is also used for array indexing.\n That appears to be in conflict, however using +[ ]+ for lists and array\n indexing will be familiar from other languages.\n\n| +\\|+\n| Used in type and structure expressions to mean \"or\" and struct, list etc\n manipulation to mean \"join\".\n\n| +{}+, +_()+ and +{: :}+\n| Minor issue, I kinda like {} for code and dictionaries and structures.\n But (so far) I've chosen to avoid these conflicts.\n\n|===\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/design_ideas.txt", "content": "Plasma Language Ideas\n=====================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: October 2017\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n\n== Ideas to consider\n\nMany of these should also wait until later. But this category is separate\nas I'm not sure that these are good ideas.\n\nGC::\n * Regions\n * Mark-compact for acyclic objects\n\nOptimisations::\n * Convert ANF to relaxed ANF then to PZ. Use the relaxed ANF to find\n single use variables and optimize them away to generate more efficient PZ.\n Do some other def-use analysis too, including for parallel tasks.\n\nTypes::\n * Use structural matching to some degree, an instance can implement more\n than one interface, and may define more than an interface requires.\n * When supporting interfaces, maybe they can be integrated with the\n package system in a kind-of \"does this package provide X?\"\n * Evaluate HKTs.\n * Refinement types / path-aware constraints.\n * Use symbols like ? for maybe and | for or, like Flow Types.\n * Consider safe/unsafe integer operations such as overflows, division by\n zero etc. Allow checking for error to be done at the end of a\n complex calculation or by throwing an exception.\n + When implementing more subtyping, during an ambigious type which the\n value of a match expression, prefer the type (if there is one) that allows\n the match to \"cover\" the whole type, and provide that as guidance to the\n solver.\n\nSyntax::\n * Add field update and conditional field update syntax.\n * Maybe remove parens from if-then-else conditions and other places such as\n match parameters.\n * Guards on cases\n * Disjunctive patterns on cases\n * SISAL allows \"masks\" (like guards or filters) on returns clauses of\n loops. This looks pretty powerful.\n * More succinct loop syntax, for simpler loops.\n * Maybe allow simple loop outputs to be specified in the loop \"head\".\n * Consider different syntax & and ,? for combining multiple loop inputs in\n lockstep or Cartesian combinations.\n * List, array and sequence comprehensions.\n * Add a scope statement that contains a block allowing shadowing of some\n variables, and hiding of any produced variables.\n * Add let expressions?\n * Add something to allow statements within expressions?\n * Probably drop { } for dictionary constants in favor of [ ] with a => to\n separate keys from values.\n + Add more logical operators to the langauge, maybe xor and implication,\n probably via keywords or functions rather than symbols.\n\nSemantics::\n * Predicate expressions as a syntax sugar for applicative.\n * https://plasmalang.org/list-archives/dev/2019-October/000033.html[Language\n \"levels\"]\n * Various ideas around resources and higher-order code:\n ** https://plasmalang.org/list-archives/dev/2018-January/000026.html[Most\n recent post]\n ** https://plasmalang.org/list-archives/dev/2017-September/000021.html[Earlier\n thread]\n\nOther::\n * Read about Facebook reason wrt naming things and syntax.\n * Use command line parsing as example code for language & library.\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/design_principles.txt", "content": "Plasma Language Design Principles\n=================================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: June 2021\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nPlasma is designed and implemented with these principals in mind. By\ndocumenting this it not only gives us something to refer to but makes\ndecisions more conscious, leading to a more consistent language. The first\nsection (The big ones) is especially important and contains:\n\n 1. Easy reasoning\n 2. Familiar syntax and terminology\n 3. Cutting-edge concurrency and parallelism\n\nThese three are mostly relevant when making big decisions about the\nlanguage, while the remaining principals are more relevant for smaller\nchoices and implementation details, including development of the tools &\necosystem.\n\nMany of these will be described with anti-examples (\"don't\"). I'd prefer to\nuse positive examples of how Plasma avoids these problems, and will try to,\nhowever most can only be recognised with these \"don't\" examples.\n\n== The big ones\n\nThese principals are the big ones, they define how we blend\ndeclarative and imperative programming among other things, and shoot\ntowards our goal of better concurrent and parallel programming.\n\n=== Easy reasoning\n\nDeclarative programming can make it easier to reason about a program,\nparticularly large programs and at a large scale (the scale of modules,\nfunctions and how they interact).\n\nFor example a Plasma function's signature tells you everything you need to\nknow about that function, not only the data types it'll work with but what\ndata it can access and what resources (eg files, network sockets) it can\nmanipulate. Plasma is a side-effect free language and borrows a lot from\nother declarative languages including its type system.\n\nThis also means that semantics should generally be easy to follow, the\nlanguage should avoid UB or non-determinism. But we can't solve\nnon-termination without solving the halting problem and otherwise maintain\nexpressitivity so we're not going to try. (TODO: explain why exceptions are\nokay / when they're okay.)\n\nThis benefits humans, who spend more time reading code than writing it, and\nmore effort debugging. A human can read function signatures and know\nwhether their bug may be or won't be within that function.\n\nIt also benefits tools, specifically the compiler. By making effects clear\nthe compiler can perform more aggressive optimisations such as reordering or\nparallelising code.\n\n=== Familiar syntax and terminology\n\nThere are two aspects to familiarity. One is generally using syntax that'll\nbe more familiar to a majority of programmers in 2021. We're assuming\npeople coming to Plasma have at least two years experience programming and\nthey may be \"functionally curious\". By being familiar where we can it makes\nlearning Plasma easier, and people can spend more of their energy learning\nthe parts of Plasma that are different (usually by necessity).\n\nWe make a number of choices about syntax that will be more familiar to most\nprogrammers. For example Functions and blocks use curly-brace syntax of\nC-like languages and the body of a function or block is a series of\nstatements.\n\nLikewise we use terminology and names that are going to be more familiar.\nWhat Haskell calls \"Functor\" we shall call \"Mappable\". We know this\nisn't as accurate as \"Functor\", but we're willing to lose some of that\naccuracy for more familiarity for more people. Documentation will usually\nexplain these kinds of choices, eg: \"If you've used Haskell you may be used\nto calling these Functors, which is more accurate\". Which also makes it\nclear to people with that background exactly what they're looking at.\n\nSometimes something is familiar to a smaller group of people. Like ADTs, we\nuse the Haskell syntax for ADTs because that's the syntax that's familiar to\nthe largest group of people.\n\nLikewise some concepts have no familiar meaning (eg Monad). We carefully\nweigh whether to include that concept at all. For example monads are very\nuseful so we will support but de-emphasise them. While GADTs are more\nspecialised in their use cases and those cases can also be solved in other\nways so we will not support GADTs.\n\n=== Cutting-edge concurrency and parallelism\n\nOne of Plasma's major goals is a language that does not restrict expression\nof concurrency or parallelism, and enables automatic parallelisation. And\ndoes all of this safely.\n\nMany other language features are designed with this in mind. For example by\nmaking loops part of the language (rather than using recursion in a\ndeclarative language) programmers will naturally tell the compiler where\nloops are and this will aid automatic parallelisation. Likewise part of the\nreason the resource system is granular is to be able to expose more parallelism.\n\n=== No paradigm is superior in all situations\n\nBoth declarative and imperative programming have a lot to offer. We choose\nlanguage features from both of these groups. Neither one is purely\nsuperior.\n\n== Language syntax\n\n=== Basic consistency\n\nC structs, and C++ classes, must be followed by a semicolon. But functions\ndon't need to be.\n\nHaskell uses square brackets for lists:\n\n * +[]+\n * +[1, 2, 3]+\n * +[a]+ (as a type expression)\n\nBut it also uses : for the cons operator, and when pattern matching with lists\ncode looks like:\n\n----\nlength [] = 0\nlength (x:xs) = (length xs) + 1\n----\n\nThis is inconsistent. Plasma has chosen the Prolog syntax for \"cons\"\n(+[x | xs]+).\n\nThere may be \"consistent\" reasons why C/C++ and Haskell make these choices.\nIndeed +:+ is an operator in Haskell while +[]+ and +[1, 2, 3]+ aren't.\nLikewise struct declarations end in a semicolon in C otherwise the next\nidentifier would be an instance of that struct. Nevertheless this is\ninconsistent _from the point of view of the programmer_. We will try to\navoid inconsistency, and may need to do this by changing other parts of the\nlanguage (if Plasma was C we'd avoid conflating structure definitions with\ndefinitions of struct instances).\n \n=== Things should look like what they are / mean what they look like.\n\nThe following Mercury code\n\n----\n(\n X = a,\n ...\n;\n X = b,\n ...\n)\n----\n\nCould be a switch (with either 0 or 1 answers) a nondet disjunction (with\nany number of answers and hard to predict complexity). The exact meaning of\nthis depends on the instantiation state of X which depends on the\nsurrounding code. You can't tell by looking how this code will behave.\n\nAlso in Mercury a goal such as:\n\n----\nA = foo(B, C)\n----\n\nCould be a test unification (semidet, very fast), a construction (det, with\na memory allocation), a deconstruction (det or semidet), or a function call\n(could do anything, including not terminate).\n\nWe will try to avoid these in Plasma. Plasma has no disjunction so the\nfirst is not a problem. But the second is currently avoided because data\nconstructors begin with capital letters (this will change, so we may need to\nrevisit this).\n\nWe've been creating a link:concept_map.html[syntax to concept map] we're\ntrying to avoid overloading symbols (where possible). For example + means\naddition and concatenation in many languages, but in Plasma (like Haskell\nand Mercury) ++ means concatenation.\n\n=== The same thing, should behave the same way in different contexts\n\nWhat people think of as application or systems languages make this error,\nand scripting languages get it right, although the difference is hard to\nnotice because it's so great.\n\nA language like python allows nested functions.\n\n----\ndef foo(...):\n x = ...\n def bar(...):\n ... x ...\n\n return bar\n----\n\nBut this is not legal in C and C++, or even a managed language like Java.\n\nThis is legal in Plasma (with Plasma's syntax). We add the additional\nconstraint that nested functions should behave like functions at the\ntop-level, they must behave the same and for example support mutual\nrecursion.\n\nWhere this is not true is that other statements are not allowed at the top\nlevel, doing so would create problems for module loading order. So\nfunctions will have to behave with respect to other statements within\nfunctions, and this may make them appear to behave differently. This is\nunfortunate but better than creating module initialisation order problems.\n\n=== Make parsing simple, for machines and humans\n\nTo simplify parsing, both for machines and humans, all\ndeclarations/definitions and many statements can be recognised by their\nfirst token. All type definitions begin with the keyword +type+ all\nfunctions with +func+ etc. Statements can begin with +if+, +match+,\n+return+, +var+ or similar, and those that don't belong to a small set\ncontaining only:\n\n * Assignment\n * Array assignment\n * Call (with effect)\n\nWhich can be disambiguated by the first 2 tokens.\n\nWe assume that this also makes it easy for humans to recognise the type of\neach statement, at least provided they find the beginning of a statement\nwhich is (by convention, not syntax) at the beginning of a line or on the\nsame line following a +{+.\n\nThis is also related to things being what they look like.\n\n=== Choose the more restrictive alternative\n\nThere are many cases where we are unable to decide what is best for the\nlanguage, particularly without experience using it in anger. In these cases\ngiven two or more choice we should choose the most restrictive. It will be\nmore pleasant later if we change to a less restrictive option, rather than\n_from_ a less restrictive option to a more restrictive one.\n\nFor example\nhttps://plasmalang.org/list-archives/dev/2018-January/000026.html[resources\nand higher-order code] was a fairly major choice we we've picked one of the\nmore restrictive options, and might find we need to relax it later.\n\n== Other\n\n=== Principle of least surprise\n\nThis is written about elsewhere online. Given two alternatives, choose the\none that surprises people the least (when other factors are equal). You can\nsee that some of the above principles are specific examples of this one.\n\n== TODO\n\n * What are the principals for how we're writing the Plasma tools?\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/design_types.txt", "content": "Plasma Type System Design\n=========================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: April 2017\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nThis is a design/set of ideas that I'm considering for Plasma's type system.\nIt is very much a draft. It is more or less an aide to help me write down\nmy ideas, work them through and eventually refine then and make them part of\nthe link:plasma_ref.html[reference manual].\n\nStarting with a type system such as the basic parts of Haskell's or\nMercury's specifically:\n\n* Discriminated unions / ADTs\n* Polymorphism\n* Abstract types\n* Existential types (later)\n* More kinds (later)\n\nStarting with this I have been considering the kinds of subtyping that OCaml\ncan do, it's pretty neat. But recently I read a\nlink:https://futhark-lang.org/blog/2017-03-06-futhark-record-system.html[blog\npost]\nby Troels Henriksen about structural typing and record syntax for Futhark.\nIt made me consider this more deeply, and now I have the following design in\nmind.\n\n== Basic stuff\n\nWe can define our own types, such as enums:\n\n----\ntype Suit = Hearts | Diamonds | Spades | Clubs\n----\n\nOr structures, this type has a single struct with named fields.\n\n----\ntype PlayingCard = Card ( suit : Suit, number : Number )\n----\n\nA combination of the above, a PlayingCard is either an ordinary card or a\njoker. An ordinary card has fields.\n\n----\ntype PlayingCard = OrdinaryCard ( suit : Suit, number : Number )\n | Joker\n----\n\nTypes are polymorphic, they may take type parameters. Identifiers beginning\nwith upper case letters denote type names and constructor names.\nIdentifiers beginning with lower-case letters denote type variables.\n\n----\ntype Tree(k, v) = EmptyTree\n | Node (\n key : k,\n value : v,\n left : Tree(k, v),\n right : Tree(k, v)\n )\n----\n\nA type alias, ID is now another word for Int. (XXX this needs revisiting).\n\n----\ntype_alias ID = Int\n----\n\nIt's often more useful to alias something more complex.\n\n----\ntype_alias Name = String\ntype_alias NameMap = Map(ID, Name)\n----\n\nType aliases can take parameters:\n\n----\ntype_alias IDMap(x) = Map(ID, x)\n----\n\n== Terminology\n\nBefore we can go further, I want to pin down some terminology.\n\nA type has a name and some parameters. Eg +Int+ or +Map(k, v)+\n\nA type declaration has multiple parts:\n\n----\ntype Tree(k, v) = EmptyTree\n | Node (\n key : k,\n value : v,\n left : Tree(k, v),\n right : Tree(k, v)\n )\n----\n\nA type declaration is made of a left hand side and a right hand side (either\nside of the +=+). The left-hand-side contains a type name +Tree+ it's\nparameters +k+ and +v+ which creates the type +Tree(k, v)+. This is also a\ntype expression but we'll get to that later.\n\nTODO: kinds.\n\nThe right hand side is a structure expression.\nA structure expression is normally made up of structures\nstructures separated by +|+ symbols (meaning \"or\"). But could be made of\nother things such as a reference to another type (+type(TypeExpr)+).\nEach structure is made up of an optional structure (the bit in the parens)\nand a tag (its name).\nThe structure is optional, if there are no fields then one should not write\nempty parens.\nAn untagged structure, which we will see later, is written with the +_+ for\nits tag.\nWhen an untagged structure is used, there must be exactly one structure in\nthe type.\nOther languages often call the tagged structures data constructors, and the\nuntagged ones tuples, but I hope that calling them both structures, and\nallowing untagged structures to use field names and share some syntax will\nbe good.\n\nNOTE: The word tag is overloaded, it also refers to an implementation detail\nfor discriminated unions, that's not what we're referring to here.\n\nEach field in the structure has a name and a type. The type is any type\nexpression. The field name is optional.\n\nFinally type expressions refer either a type like +Map(k, v)+ (including\nabstract types), or multiple type expressions separated by +|+,\nor arbitrary structure expressions when wrapped in +struct()+. The\n+struct()+ wrapper avoids ambiguity between tags and types. Likewise, and\nnot mentioned above, structure expressions can refer to whole types with\n+type()+.\n\nAny type variables appearing in structures (on the RHS of the = in the type\ndeclaration, must appear exactly once on the LHS. This may need to change\nfor existential types (TODO).\n\n== Ranged numeric types\n\nIt is sometimes desirable to specify the size of a numeric type. Eg\nuint16_t. That's great if you're thinking \"this should fit in 16 bits\".\nBut if what you're thinking is \"I want to count numbers 0 to 200\" it's more\nhuman to specify a range (see Ada). This could mean storing more, than the\nrange when that's easier, or checked arithmetic.\n\nLikewise floating point numbers could be specified by how many sagnificant\ndigits are important.\n\nAlso consider an integer type with modulo (probably power-of-two)\narithmetic.\n\n== Subtyping / constructors are \"shared\"\n\n----\ntype TypeA = A | B\ntype TypeB = A | B | C\n----\n\nA function that accepts parameters of type +TypeA+, cannot be passed\nvalues of +TypeB+. But a function accepting parameters of type +TypeB+ can\nbe passed values of +TypeA+.\n\nThis works along with type inference. This function:\n\n----\nfunc my_func() -> _\n{\n return A\n}\n----\n\nIs known to return +A+ which is covered by either +TypeA+ or +TypeB+. This\nfunctions inferred return type will be +struct(A)+. Which we know we can\npass as either TypeA or TypeB. Care will need to be taken when generating\nerror messages.\n\nLikewise, if +my_func+ was defined as:\n\n----\nfunc my_func(...) -> _\n{\n if (...) {\n return A\n } else {\n return B\n }\n}\n----\n\nThen it would be inferred as returning +TypeA+ since we already have a name\nfor +struct(A | B)+.\n\nTypes defined in separate modules outside the view of each-other can't share\ntags. This is not the limitation it seems, since usually when such a\nfeature is required it is to extend, or in some cases reduce, the\nconstructor symbols of an existing known type.\n\n----\ntype AdvancedNode(a) = type(BasicNode(a))\n | AdvancedStruct (\n ...\n )\n----\n\nNOTE: See below for how recursive types are handled.\n\nTODO: it may be useful to let a type explicitly specify that it\nextends/subtypes an earlier type. This may match more with programmer\nintentions.\n\n== Magic type tagging.\n\nI think I saw this in Perl 6.\n\n----\nfunc do_something(...) -> Result | Error\n{\n ...\n}\n----\n\nThat's easy provided that both these types have all their structures tagged,\nbut Ints, Strings, etc don't work like that (each Int, String etc is like an\nalternative tag in an infinite or really large set of tags).\n\nWhere all the types in a type expression are named, then they may also be\nswitched by type, rather than just value. (the compiler tags and probably\nboxes them internally).\n\n----\nfunc print(x : Int | String) -> String\n{\n return switch_type(x) {\n Int -> int_to_string(x)\n String -> \"\\\"\" ++ x ++ \"\\\"\"\n }\n}\n----\n\n\n== Ordering\n\nThis kind of subtyping must work via an ordering. There is a partial\nordering over all types, types that refer to something _more specific_ are\n_greater_ in this ordering. Therefore: +A | B+ > +A | B | C+.\n\nBeing a partial ordering some types cannot be compared, eg: +A | B+ and +B |\nC+. This means that neither is a subtype of the other.\n\n\n== Adding fields.\n\nThis can vary depending upon how programmers express deconstructions.\nUsually a deconstruction is (semantically) a match statement.\n\n----\nmatch (a) {\n A (x) -> { return x }\n}\n----\n\nThe equivlient deconstruction might look like:\n\n----\nA(x) = a\nreturn x\n----\n\nThis matches A with a single field.\nIt would also match any A with at least one field, extracting only the\nfirst.\nLet's make a new structure expression for that: +A/1+, this kind of type\nexpression wont appear in programs or even error messages, but we need it\nhere to discuss subtyping and ordering.\n\nBut fields can also be extracted or structures can be matched using field\nnames.\n\n----\n# Field selection.\nreturn a.field1\n\n# Match with fields.\nmatch (a) {\n A(x = field1) -> { return x }\n}\n----\n\nTherefore we also need to talk about subtyping with regard to fields and\ntheir types. We write the type of a in these as: +struct(A(field1 : t))+\n(t is currently abstract). It's more correct to say that the first is\n+struct(_(field1 : t))+ since the constructor symbol isn't mentioned.\n\nAny use of a constructor, such as the match statement but not the field\nselection, requires a type to have already been declared. This will make\nmore sense later with tagless structures. For now lets just say we require\na type to exist.\n\nFor example, either +TypeA+ or +TypeB+ match the above usages.\n\n----\ntype TypeA = A (\n field1 : Int\n )\ntype TypeB = A (\n field1 : Int,\n field2 : String\n )\n----\n\n\n== Ordering with fields\n\nA structure expression with more fields is greater than one with fewer:\n+struct(A/2)+ > +struct(A/1)+.\n\nA structure expression with a superset anther's fields is greater:\n+struct(A( field1 : Int, field2 : String ))+ > +struct(A ( field1 : Int ))+,\nOr: +TypeB+ > +TypeA+\n\nA structure expression with a constructor and with the same or a superset of\nanothers fields is greater:\n+struct(A( field1 : Int ))+ > +struct(_(field1 : Int))+,\n\nFields are compared by name and type. A field whose type is greater than\nthe corresponding field of another type, is greater. This makes ordering\ncomposable, and work as desired on recursive types.\n\nStructures whose fields are neither a set or superset cannot be ordered.\nStructure expressions with numbers cannot be ordered with those by types.\n\nWidening is performed when a type or a constructor symbol is named,\nor if no ordering is found between two types, they are widened in an attempt\nto find a common type.\nWidening allows more programs to be well typed, makes the type system easier\nto use, however it makes type more specific than strictly necessary.\n\nA type expression such as the above is widened to the disjunction of the\nequal-least specific types matching the expression. Nevertheless we\ndiscussed ordering of these expressions so that we can determine ordering of\ntypes and which type an expression may be widened to.\nWidening must also respect the types created by type expressions the\ndeveloper writes, such as in the declaration of a function:\n\n----\nfunc do_something(...) -> Result | Error\n{\n ...\n}\n----\n\nIn this case +Result | Error+ is considered for widening.\n\n== Untagged structures\n\nAn untagged structure can be used, but without any other structures within\nthe same type. The missing tag must be written with +_+.\n\n----\ntype TypeC = _(\n field1: Int,\n field3: Bool\n )\n----\n\nUses of untagged structures are not widened unless combined with a named\nstructure or type containing a named structure. This makes them feel more\n\"dynamic\" although they simply use type inference heavily.\nFor example:\n\n----\ndict_from_kv_list(map(\\x -> _( key = get_id(x), value = x ), list))\n----\n\nTODO: I think +:+ is the best operator here, but it conflicts badly with\n\"has type\". +=+ is also okay. Arrows can be a problem as the directions\nmatter, and sometimes you want them one way or the other.\n\nWithout needing to declare a type, using an untagged structure like this\nimplicitly creates one for us.\n\n\n== Syntax\n\nWe've already seen some syntax above. But I'd like to expand on that now.\n\nType structures use parentheses +( )+, fields are separated by commas and\nthe tag may either be an identifier starting with a capital letter or the\n+_+ symbol.\nEach field separates it's field name from the field type (in\ndeclarations) with a +:+ (meaning \"type of\").\n\nDeconstructions may be done with fields (using a =, with the new variable on\nthe left) or by position. Constructions are done either positionally or\nwith the field name on the left.\n\nSelection is performed using the +.+ operator, the general scoping operator.\n\n----\nx = point.x\n----\n\nThis may be chained for nested structures.\n\n----\na = struct.field1.next_field.other_field\n----\n\nField update (in an expression) is introduced via the join symbol: +|+\n\n----\nnew_struct = _( old_struct | field = new_value )\n----\n\nNested fields may also be updated, updating all the structures along the\nway.\n\n----\nnew_struct = _( old_struct | field.next_field.following_field = new_value )\n----\n\nMultiple fields may be updated in one expression.\nThese expressions will introduce fields if necessary (subject to type\nchecking).\nThese will also work for tagged structs.\n\nA syntas sugar for state variables in statements will probably be\nintroduced.\n\n=== Syntax TODOs\n\n.Projection / Explosion / Filtering\nAdditional syntax could be created to merge structs (exploding one into\na series of updates to another). Filtering (technically projection) may\nalso have some use, either to satisfy the type system or to free memory.\n\n.Lenses\nLenses (optics?) provide some additional power not provided here. It'd be\nnice to handle that if possible.\n\n== Co-variance and contra-variance\n\nTODO: I will need to address this to support arrays.\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/dev_bugtracking.txt", "content": "Plasma Bugtracking \n==================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: Feburary 2022\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n\nWe use the github bugtracker, and while users/new contributors and such\nshould be able to submit a bug without too much process. We need a little\nmore process to decide which bugs are important and what we should be\nworking on when.\n\nThese guidelines might change a bit as we settle in and figure out what\nworks.\n\n== Background\n\n=== Roadmap\n\nThe link:https://plasmalang.org/roadmap.html[Plasma Roadmap] is published on\nthe website and gives a high-level overview of what we want to work on.\nIt divides our progress into several milestones, each milestone is made of\nseveral features.\n\n=== Releases & Versioning\n\nPlasma is currently not-quite usable (I must remember to update this doc\nwhen it is!) and so there are currently no version numbers or release\nschedule. Once it is I think it'd be fairly reasonable to manage two\nreleases per year using something like a\nlink:https://en.wikipedia.org/wiki/Software_release_train[train model] -\nbecause it's more important to release _something_ rather than have a\nrelease wait potentially indefinitely for a particular feature.\nIt's my guess that twice yearly is not too fast that each release will have\na reasonable number of new features, but not too slow that anyone feels\nthey're waiting too long to get new features.\n\nRegarding bugs this means which version a feature _lands_ in is only meaningful\nwith regard to relative priorities, and bugs/features don't need to be\ntagged with a version.\n\nThat said, there will probably be meaningful versions such as \"1.0\" where we\ndeclare some API/language/library stability.\n\n=== Github\n\nGithub's bugtracker allows us to\nlink:https://github.com/PlasmaLang/plasma/labels[label issues].\nWe already have several kinds of labels\n\n Type:: bug, enhancement, maintenance, optimisation\n Component:: build, compiler, runtime, gc, language, docs etc\n Skill:: C++, Mercury, Type system, etc\n Meta:: help-wanted, good-first-bug, no-domain-knowledge\n Status:: new, accepted, duplicate, invalid, wontfix, resolved\n Type:: bug, enhancement, maintenance, optimisation\n Other:: project\n\nWe will extend these and probably rename a few of them.\n\nGithub also supports a notion of milestones. I beleive these function like\nlabels except that an issue may only belong to a single milestone. The\nlink:https://github.com/PlasmaLang/plasma/milestones[Milestones view] has\nnice progress bars too.\n\nGithub also supports project boards, Some large tasks have project boards\n(eg the module system).\n\nWe may not always use github, TODO: find a way to download all this data\nfrom github.\n\n== Milestones & tasks\n\nthe link:https://plasmalang.org/roadmap.html[roadmap] divides our work into\nmilestones and tasks. Each roadmap task shall be a github milestone.\nFor example, some current milestones are:\n\n * Testing\n * Interfaces\n * Text handling\n * Language groundwork\n * Ergonomics\n * Closures & functional features\n * Modules MVP\n * FFI\n * Standard library\n\nThese should correspond to current roadmap items. Not all of them currently\ndo.\n\n== Triaging & labelling\n\nTriaging is a process by someone looks at the issue and assigns various\nattributes to help with sorting/finding that issue later. It usually\ndecides the issue's priority (in our case, milestone). Triaging is the\nresponsibility of project maintainers, users do not need to worry about\nthis.\n\nEach issue may have have one or more labels for skills, and usually one for\ncomponent but this may be more if it's a cross-cutting issue or zero if it\ncovers the project as a whole.\n\nEach issue should have exactly one type or be a project bug\n(bug, enhancement, maintainance task or optimisation).\n\nEach issue may belong in a milestone and/or a project board.\n\nEach issue should have a status, it should begin as \"new\".\n\nUntriaged bugs can be found with\nlink:https://github.com/PlasmaLang/plasma/issues?utf8=%E2%9C%93&q=is%3Aopen+-label%3A%22meta%3A+triaged%22+[this search].\n\nTo summarise, to triage a bug assign:\n\n * The \"status: new\",\n * one type label,\n * probably one component or feature label, maybe more,\n * any number of skill labels,\n * meta labels as appropriate,\n * if the bug is part of some larger goal it should have a milestone and\n possibly also belong to a project board.\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/dev_compiler_internals.txt", "content": "Plasma Compiler Structure / Internals\n=====================================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: November 2019\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\n== Compiler structure\n\nA compiler is typically organised in multiple passes that form a pipeline.\nPlasma is no different in this respect.\n\nCompilers also use one or more data structures that represent the code and\nother information during compilation. You may have heard of abstract\nsyntax trees (ASTs) and immediate representation, these are similar\nconcepts. We will say _representation_ and use it to mean any\nrepresentation of a program in the computer's memory (not disk), and not\nworry about the specifics of definitions like ASTs.\n\nSome representations have \"textbook\" definitions, eg: single-assignment form\n(SSA) or a normal form (ANF). Each representation has strengths and\nweaknesses, compilers including Plasma also use their own unique\nrepresentations. Plasma has four main representations used within the\ncompiler: AST, Pre-core, Core and Plasma Abstract Machine (PZ).\n\nCompilation passes take in the program in a representation and return the\nmodified program in the same representation, and sometimes in a different\nrepresentation. Again some of these are \"textbook\" passes (inlining,\nregister allocation) while others are unique to the compiler or language.\nAn optimisation pass may operate on the core representation, returning the\nupdated program in core representation. And a translation pass like code\ngeneration may take the core representation and return PZ. Some passes\ndon't modify the program but annotate it with extra information, such as\ntype inference. Some passes check the program for validity, like type\nchecking. In Plasma type inference and type checking are the same pass.\n\n=== Lexing & Parsing\n\nWIP\n\n=== AST\n\nWIP\n\n=== Pre-core\n\nThe pre-core representation is a statements-and-expressions like\nrepresentation (similar to the AST representation) however all symbols have\nbeen resolved. This means where a name appeared in the AST it has been\nresolved to what kind of symbol it is: a function, a variable etc, and an\nID. (IDs are internally integers and allow for faster lookups).\n\n==== Environment\n\nThe environment is a non-tangible concept (it's computer science, none is\nreally tangible) which means it does not appear in people's programs but it\nis a concept that programmers may experience.\n\nDefined functions, imported modules and their symbols, local variables are\nall part of the environment. Environments form a chain. Each new scope\ncreates a new environment that refers to the previous one. During\ncompilation the environment is real, specifically during the AST->Pre core\ntranslation. A chain of environments are created and used to resolve\nsymbols.\n\n==== Meta information\n\nEach statement (+pre_statement+ type) has some meta-information associated,\nthis contains context information (source file and line number) plus other\nfields, see the +stmt_info+ type.\nThis means that if a statement spans multiple lines we only record the\ncontext information for the beginning of the statement. A compilation error\nlater in the statement will be reported for the first line.\nWe can fix this later.\n\n===== Def/use\n\nThe initial AST->Pre-core pass populates populates def-use information on\neach statement.\nEvery variable defined (assigned a value) by a statement will appear in that\nstatement's _def_ set.\nEvery variable referred to (excluding assignments) by a statement will\nappear in that statement's _use_ set.\nThese sets are used later to check scoping and lifetimes (variables are not\nused before they're defined).\n\n===== Reachability\n\nCode is annotated with this value to describe whether execution can reach\nits end, always, sometimes or never. This is then used to check that a\nvariable is defined along all execution paths that reach their end.\n\nReachability is computed as the 3rd pre-core phase. It is invalid until\nthen.\n\n==== Phases\n\nOnly code is handled in the pre-core phases. Data types and other entries\nare translated straight from AST into core representation.\n\nThe pre-core phases are executed from +ast_to_core_funcs+ in\n+pre.ast_to_core.m+, they are:\n\n1. +func_to_pre+ translates AST functions into pre-core, this resolves\n symbols using the environment concept. It also populates def-use sets.\n\n2. +compute_closures+ computes the captured variable sets by traversing the\n statements taking note of which variables are available, then when a\n closure is found calculating the variables captured by the closure.\n\n3. +fix_branches+ fixes how variables are used in branching code, it:\n** checks that used variables are always well defined (eg\n along all execution paths)\n** Updates the reachability information for branches.\n Reachability information is incomplete until after\n type checking.\n** Adds terminating \"return\" statements where needed.\n\n4. +check_bangs+ checks that the ! symbols are used correctly. They must be\n used when required, must not be used when not required, and only one may be\n used per statement.\n\n5. +pre_to_core+ translates the pre-core statement-oriented representation into\n the core representation (similar to ANF) which is expression oriented.\n Statements are translated out of order, with the statements following the\n current statement being translated first, as a continuation, then that\n expression is fed into the translation of the current statement.\n This helps translate something like a sequence of assignments into a set of\n nested let expressions.\n\n=== Core\n\nWIP\n\n=== PZ\n\nWIP\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/dev_howto_make_pr.txt", "content": "How to make a pull request\n==========================\n:Author: Gert Meulyzer\n:Email: gert@plasmalang.org\n:Date: April 2019\n:Copyright: Copyright (C) Plasm Team\n:License: CC BY-SA 4.0\n\n* Show a real life example from start to finish on how to do a good PR.\n\n_Draft text follows!_\n\nIt's hard to start contributing to an open source project. Especially if\nit's your first one. We present a flow here for you to follow and will show\nan example of an actual commit to the codebase. (You can find the commit\n*here* and the PR *here*) This way of working should be good for most\nprojects you commit to, but be sure to check the contribution guidelines for\nevery project. Ours is in the\nhttps://github.com/PlasmaLang/plasma/blob/master/CONTRIBUTING.md[CONTRIBUTING.md]\nfile.\n\n1. Fixing the bug.\n\nWe found a bug on line 81 of\nhttps://github.com/PlasmaLang/plasma/blob/master/runtime/pz_option.h#L81[runtime/pz_option.h].\nThere is one 'l' too many. We'll fix it up so it's spelt correctly and\ncommit it to git.\n\n* Use the correct Git commit message structure\n* Show how to clean up your local branches afterwards when it gets accepted.\n* Show how to to additional modifications\n* Maybe some git rebase and squash stuff\n\nNOTE: https://github.com/PlasmaLang/plasma/blob/master/runtime/pz_option.h#L81 temporarily has too many 'l's. This is a good bug to fix and make a PR from.\n\n* The git message structure documentation is in:\n https://github.com/PlasmaLang/plasma/blob/master/CONTRIBUTING.md So make\n sure to put a reference to it there.\n\n* From CONTRIBUTING.MD: Log messages should follow the style:\n\n ```\n [component(s)] Title\n\n Description\n\n Any other changes including changes that were needed to support this\n change or followed as a consequence of this change.\n ```\n\n We provide a .gitmessage in the root of the repository.\n Run this command to start using the new commit message template:\n\n ```\n git config --local commit.template /path/to/repo/.gitmessage\n ```\n\n* Make sure to mention this and refer to the correct document to refer to in\n case of doubt. Who knows, this might change again in the future.\n\n* In CONTRIBUTING.md it says: “Each file should be listed with more detailed\n information. Take a look at previous changes for examples.” => We could go\n look for some good examples and show them in this document.\n This was removed you can list a summary of changes in each/some files if\n you think it may help whowever is reviewing your change.\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/dev_maintainers.txt", "content": "Plasma Maintainer's Guide\n=========================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: July 2022\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nThis is the maintainer's guide, it will contain procedures for maintainer's\ncommon tasks. However it is incomplete (Bug #48).\n\n== Merging changes\n\nGenerally ongoing work should be done on a feature branch and merged to the\nmain branch. These branches could be in ones own fork of the plasma repository\nor in this one, then be merged.\n\nAt some stage we may use the bors tool to manage this for us. For now\nthough it's manual. Make the commit using:\n\n git commit merge --no-ff --log=999 -S branch_name\n\nThe commit message should be formatted like:\n\n [merge] Mutually importing modules works\n \n This patch series mainly gets mutually inclusive modules working, but\n does some other tidying up also.\n \n Fixes #123\n \n * modules:\n [compiler/pre] Save types and resources' full names\n [compiler/pre] Module qualify definitions in interface files\n [compiler/ast] Move names out of ast_resource and ast_type\n\nA merge commit should also have some github Fixes directives. Eg \"Fixes: #123\"\nto say that the commits fix bug #123. If the author of the patches already\nincluded this directive within the patch series then it's not necessary in the\nmerge commit. A pull request / patch series may fix more than one bug.\n\n== Copyright years\n\nAt the beginning of each calendar year update the copyright statements in\nthe following files:\n\n * LICENSE\n * README.md\n * runtime/pz_main.cpp\n * src/constant.m\n\nAnd the copyright statement on the website, in it's repository at:\n\n * _includes/footer.html\n\nCopyright statements with years in each source file don't need to be\nupdated, and the year parts can now be phased out to read as:\n\n Copyright (C) Plasma Team\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/dev_mercury_grades.txt", "content": "Mercury Grades\n==============\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: March 2020\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n\nPlasma is written in Mercury\n(at least until we get to a https://plasmalang.org/roadmap.html[self\nhosting] stage)\nwhich means if you want to compile Plasma (to contribute to it) you may need\nto build Mercury from source,\nand that means navigating the Mercury grade system.\n\nMercury supports many different \"grades\", each one is a collection of\nsettings for how to build and link a Mercury program or library.\nEach grade is made out of many grade components separated by +.+\n\nAlternatively you may be able to use one of these shortcuts or check out\nhttps://plasmalang.org/docs/getting_started.html[getting started with\nPlasma].\n\n * If you just want to run Plasma, without compiling it, then try this\n https://plasmalang.org/plasma-static.tgz[static build] for Linux on\n x86_64.\n (TODO: https://github.com/PlasmaLang/plasma/issues/9[better static builds]).\n * If you want to build Plasma on x86 or x86_64 on a .deb based Linux\n system;\n then use the https://dl.mercurylang.org/deb/[Debian packages], see \n https://plasmalang.org/docs/getting_started.html[getting started] for more\n information.\n * If you want to run Plasma or if you want to develop for it, then there's\n also a https://plasmalang.org/docs/getting_started.html#_docker[docker\n image].\n * If you want to build Plasma on a non-.deb system on x86 or x86_64 then\n you'll have to build Mercury. I suggest installing the +asm_fast.gc+ and\n +asm_fast.gc.decldebug.stseg+ grades. Remember to tell +./configure+ which\n grades you need otherwise it'll\n http://yfl.bahmanm.com/Members/ttmrichter/yfl-blog/mercury-time-to-hello-world[try to build all of them and could take a long time]\n (TODO: https://github.com/PlasmaLang/plasma/issues/8[provide detailed\n instructions]).\n * If you have some other type of system, or are building something other than\n Plasma but found this document, then read on.\n\nThe Mercury project documents its grade components\nhttps://www.mercurylang.org/information/doc-latest/mercury_user_guide/Grades-and-grade-components.html#Grades-and-grade-components[here (retrieved 2018-03-04)],\nand I will be clarifying some points made there.\nThis manual, when I retrieved it, mentioned a few grade components not worth\nattempting to use, these are:\n\n+hl+::\n The +hl+ grade component is like the +hlc+ grade but uses a different\n format for data on the heap. It doesn't provide a significant advantage over\n +hlc+ so isn't useful.\n+il+:: A deleted .net backend.\n+agc+:: A bit-rotten garbage collector.\n+threadscope+:: A bit-rotted profiling system, the viewer component's latest\nversion can no-longer open profiles generated by Mercury.\n+mm+ and probably others:: alternative evaluation strategies for logic\nprogramming, you probably don't need this and if you do, someone else will\ntell you.\n+rbmm+ region based memory management:: An advanced optimisation for memory\nallocation. AIUI it only works for single module programs and is\nexprimental.\n\nThere are many other `secret' grade components not covered here or in the\nUser's guide.\nThey are mostly experimental and include grades like +rbmm+.\nIf you think they should be documented here then please\nhttps://www.plasmalang.org/contact.html[let us know].\n\n== Base grade\n\nEverything starts with a base grade.\nThe base grade selects which compilation backend you wish to use.\nSome backend have more than one base grade, and there are two C backends.\nExactly one base grade must be part of every valid grade string.\n\nLow-level C:: +none+, +reg+, +jump+, +asm_jump+, +fast+ or +asm_fast+\nHigh-level C:: +hlc+\nC#:: +csharp+\nJava:: +java+\nErlang:: +erlang+\n\nIf you need to call C#, Java or Erlang foreign code then the choice is\nfairly obvious.\nIf you need to work with C foreign code, as the Plasma compiler does,\nthen things are more complicated.\nFor a long time the Low-level C backend generated faster code than the\nHigh-level one, at least when comparing the +asm_fast+ and +hlc+ grades.\nThese days, due to changes in the C compilers, it depends on the program\nbeing run.\n\n=== Choosing a low-level C grade\n\nAssuming you might use the low-level C grade, read this section.\n\nThe low-level C grade uses a combination of three optimisations ('hacks')\nprovided by GCC.\nWith all three disabled, the base grade is +none+, with all three enabled\nit's +asm_fast+.\n\n.Low-level C Optimisations\n|========================\n| Grade | GCC global registers | GCC Non-local GOTOs | ASM Labels | Useful\n| +none+ | N | N | N | Y\n| +reg+ | Y | N | N | Y\n| +jump+ | N | Y | N | N\n| +fast+ | Y | Y | N | N\n| +asm_jump+ | N | Y | Y | N\n| +asm_fast+ | Y | Y | Y | Y\n|==========================================================================\n\nOf course you want as much optimisation as possible, so choose +asm_fast+\nbut not all compilers (including GCC) fully support these GCC extensions so\nthese grades may not work.\nNote that ASM labels cannot be used without GCC Non-local gotos, so there's\nno grades combining those.\nNote also that I've included a \"Useful\" column, these are the ones worth\ntesting, the others are only of interest to researchers, since if they work,\nit's almost a certainty that +asm_fast+ works.\n\nSo choose in order of preference: +asm_fast+, +reg+ then +none+. On x86 and\nx86_64 on Linux with GCC or Clang, +asm_fast+ works (but a future version of\nGCC or Clang could break this).\nOn OS X I think only +none+ works, but I don't remember.\n\n== High level C\n\nAs mentioned above, +hlc+ and +asm_fast+ are (IIRC) comparable\nperformance-wise.\nWhich one you choose will depend on whether your C compiler can handle\n+asm_fast+ and what other features you may need (see below).\nFor example, if you want to use the declarative debugger, then you must use\na low-level C grade, if that low-level C grade happens to be +none+, then\nthat's the best you can do.\n\n== More grade components\n\nThe complete grade is built by adding grade components to select different\nfeatures, separated by periods.\n\nGarbage collection::\n\n--\n+gc+ or absent.\n\n+gc+ is Boehm GC, the only supported GC.\nNot including +gc+ means that a GC will not be built, but note that Java,\nC# and Erlang backends provide a GC anyway, and for them +gc+ does not\nmake sense.\n\n(+agc+ bitrotted long ago, and +hgc+ was an experiment never completed.)\n\nYou should always include +gc+ when using a C backend.\nNot including this is intended only for testing.\n--\n\nThread safety::\n--\n+par+ or absent\n\nLike the +gc+ option, this only makes sense on C grades.\nGrades that include +par+ are thread safe and support the functions in the\nthread module of the standard library.\nThe Java, C# and Erlang grades support thread safety implicitly.\n\nLow level C::\n The threading model is N:M with IO that can block a whole \"engine\" of\n workers.\n The parallel conjunction operator and the 'very' experimental\n https://paul.bone.id.au/pub/pbone-2012-thesis/[automatic parallelism]\n work are supported.\n This is the only combination of base grade and +par+ that support these\n features.\n\nHigh level C::\n This uses the OS's native threads and IO works properly, but parallel\n conjunction is not supported.\n\nPlasma doesn't use thread-safety in any of its Mercury programs.\n--\n\nStack segmentation::\n--\n+stseg+ or absent\n\nMeaningful only on low-level C grades where Mercury manages its own stack.\nUse a segmented stack so that\n * The program is more tolerant of deep recursion s where TCO/LCO were not\n used/available.\n * The memory cost of a thread in +par+ grades is much cheaper.\n\nThis is recommended when +par+ is used and can also help with debugging and\ndeep profiling.\n\nThe +trseg+ grade component looks similar and is described below.\n--\n\nSingle precision float::\n--\n+spf+ or absent\n\nUse +float+ for floating point numbers rather than +double+.\nMuch faster on 32bit platforms where floats normally require boxing, but\nyour program may have different results \n\nOnly meaningful in C grades (I think).\n--\n\nDebugging::\n--\n+debug+, +decldebug+, +ssdebug+ or absent\n\nWhich type of debugging to support if any.\nNote that +decldebug+ is a superset of +debug+, you might as well use it\ninstead of just +debug+.\n+ssdebug+ is a totally separate debugger suitable in the \"MLDS\" backends\n(high level C, C#, Java and Erlang).\n--\n\nProfiling::\n--\n+prof+, +memprof+, +profdeep+ or absent\n\nWhat type of profiling to support if any.\n+prof+ and +memprof+ have a smiliar workflow.\n+profdeep+ is a\nhttps://mercurylang.org/documentation/papers.html#mu_01_24[very advanced profiler]\nand worth considering.\n\nThese only make sense with low-level C grades.\n\nWe're not concerned about Plasma's compiler's performance until well after\nbootstrapping, so you probably won't need this for Plasma.\n--\n\nTrailing::\n--\n+tr+, +trseg+ or absent.\n\nEnable trailing support.\nTrailing is a technique for undoing destructive update on backtracking.\nIf you don't know what it is then you probably don't need it. need this \n+tr+ is generally discouraged in favour of +trseg+.\n\nI believe this option is supported with all the C backends.\n--\n\n== Grade compatibility\n\n.Grade component compatibility matrix\n|====================================\n| | asm_fast1 | hlc | java | csharp | erlang | gc | par | stseg | tr/trseg | debug/decldebug | ssdebug | prof/memprof | profdeep\n| asm_fast | - | N | N | N | N | R | Y2 | Y |\n Y | Y | y | Y | Y\n| hlc | N | - | N | N | N | R | Y3 | N |\n Y | N | Y | y | N\n| java | N | N | - | N | N | n | n | N |\n ?D | N | Y | N | N\n| csharp | N | N | N | - | N | n | n | N |\n ?D | N | Y | N | N\n| erlang | N | N | N | N | - | n | n | N |\n ?D | N | Y | N | N\n| gc | Y | Y | n | n | n | - | Y | Y |\n Y | Y | y | Y | Y\n| par | Y2 | Y3 | n | n | n | Y | - | R |\n ? | ?D | ? | ?D | N\n| stseg | Y | N | N | N | N | Y | Y | - |\n Y | Y | y | y | Y\n| tr/trseg | Y | Y | ?D | ?D | ?D | Y | ? | Y |\n - | Y | ? | y | ?\n| debug/decldebug | Y | N | N | N | N | Y | ?D | R |\n Y | - | D | ?D | ?D\n| ssdebug | y | Y | Y | Y | y | y | y | y |\n y | D | - | ? | ?\n| prof/memprof | Y | ? | N | N | N | Y | ?D | y |\n y | ?D | ? | - | N\n| profdeep | Y | N | N | N | N | Y | N | R |\n ?D | ?D | ? | N | -\n|=====\n\nY:: Compatible\ny:: Probably compatible\nN:: Not compatible\nn:: Not compatible, but implied support by the base grade\n?:: Don't know.\n?D:: Don't know, but I doubt it\nR:: Recommended to add the column grade component if you're using the row\ngrade component\n1:: asm_fast could mean any of the LLDS base grades, see table 1.\n2:: asm_fast.par supports parallel conjunction and the experimental\nauto-parallelism. It uses green threads however IO will block an entire\nworker thread, you may be able to avoid that with spawn.native.\n3:: hlc.par does not support parallel conjunction or auto-parallelism. It\nuses pthreads so works correctly with IO.\n\n== My favorite grades\n\nI use Linux on x86_64.\n\nDefault::\n +asm_fast.gc+, or maybe +hlc.gc+\nThread safety::\n +asm_fast.par.gc.stseg+\nDebugging::\n +asm_fast.gc.decldebug.stseg+\nProfiling::\n +asm_fast.gc.profdeep.stseg+\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/dev_style_c.txt", "content": "Plasma Development C and C++ Style Guide\n========================================\n:Author: Paul Bone\n:Email: pbone@plasmalang.org\n:Date: January 2019\n:toc:\n\nThis document describes our C and C++ programming style.\nWhile it's a good idea to conform to the project style, there may be\nexceptions where departing from the style produces more readable code.\n\nIn brief, we use C99 and C++11 (no RTTI or exceptions) on POSIX, lines are\nno more than 77 columns long, indentation is made with four spaces and curly\nbrackets appear at the end of the opening line except for functions.\n\n== General Project Contributing Guide\n\nFor general information about contributing to Plasma please\nsee\nlink:contributing.html[our contributors' documentation].\n\n== File organization\n\n=== Modules and interfaces\n\nWe follow a pattern on C to allow us to emulate (poorly) the modules of\nlanguages such as Ada and Modula-3.\n\n* Every +.c+/+.cpp+ file has a corresponding +.h+ file with the same base\n name. For example, +list.c+ and +list.h+. The exceptions are:\n** The alternative interpreters are exceptions, they share the same header\n +pz_interp.h+ but have different implementations.\n** Each interpreters implementation begins with the same prefix, such as\n +pz_generic_*.c+ which is the generic interpreter's files.\n** +pz_main.cpp+ is also an exception,\n it only exports +main()+ which needs no declaration.\n** Finally +pz_gc_layout.h+ is an exception, it provides the class eclarations\n for the GC's layout while other files contain the implemention organised\n by function. This organisation groups functions with related behaviours\n which makes more sense than by class.\n* Not all +.h+ files have a corresponding +.c+/+.cpp+ files.\n* We consider the +.c+/+.cpp+ file to be the module's implementation and the\n +.h+ file to be the module's interface. We'll just use the terms `source\n file' and `header'. C++ templates are an exception since their\n implementation must be in a header file, these headers have special names\n ending in +template.h+\n* All items exported from a source file must be declared in the header.\n Declarations for variables (although rare) must use the +extern+ keyword,\n otherwise storage for the variable will be allocated in every source file\n that includes the header containing the variable definition.\n* All items not-exported from a module must be declared to be static.\n* We import a module by including its header. Never give +extern+ or forward\n declarations for imported functions in source files. Always include the\n header of the module instead. When C++ classes form cycles, forward\n declare one of the class names to break the cycle immediately before its\n use.\n* Each header must include any other headers on which it depends. Hence\n it's imperative every header be protected against multiple inclusion.\n Also, take care to avoid circular dependencies where possible.\n* Always include system headers using the angle brackets syntax, rather than\n double quotes. That is +#include +. Plasma-specific headers\n should be included using the double quotes syntax. That is\n +#include \"pz_run.h\"+ Do not put root-relative or `..'-relative\n directories in +#includes+.\n* Includes should be organised into 4 groups, separated by a blank line:\n +pz_common.h+, system includes, this module's header file, other Plasma\n includes. Each group should be sorted alphabetically where possible.\n\n=== File names\n\nC/C++ language source and header files should begin with the prefix +pz_+.\nThe C language does not have a namespace concept, prefixing C symbols with\n+pz_+ can make linking, and debugging linked programs easier. In C++ use\nthe +pz+ namespace.\n\n=== Organization within a file\n\nSometimes a file (header or source file) will cover multiple concepts. In\nthese cases the order above may be broken in order to keep things with the\nsame concept together. For example, this may mean placing a +struct+\nfollowed by the functions that operate on it, followed by a global variable,\nand the functions that operate on it.\n\nIn some cases the environment may force a different order. For example C\npreprocessor macros may need to be placed in a specific order.\n\nGenerally items within a file should be organised as follows:\n\n==== Source files\n\nItems in source files should in general be in this order:\n\n. Prologue comment describing the module.\n. +#includes+\n. Any local +#defines+.\n. Definitions of any local (that is, file-static) global variables.\n. Prototypes for any local (that is, file-static) functions.\n. Definitions of functions.\n\nWithin each section, items should generally be listed in top-down order, not\nbottom-up. That is, if +foo()+ calls +bar()+, then the definition of +foo()+\nshould precede the definition of +bar()+.\n\n==== Header files\n\nItems in headers should in general be in this order:\ntypedefs, structs, unions, enums,\nextern variable declarations,\nfunction prototypes then\n#defines\n\nEvery header should be protected against multiple inclusion using the following idiom:\n\n[source,c]\n----\n#ifndef MODULE_H\n#define MODULE_H\n\n/* body of module.h */\n\n#endif // ! MODULE_H\n----\n\n[TODO]\n====\nUpdate headers to use the new style comment\n====\n\n== File encoding\n\n* Files should be saved as ascii or UTF-8 and must use unix style (LF)\n line endings.\n* Lines must not be more than 77 columns long.\n* Indentation is to be made with spaces, usually four spaces.\n* One line of vertical whitespace should usually be used to seperate\n top-level items and sections within an item. Two lines may be used at the\n type level to create more separation when desired.\n\nTODO editor hint for vim.\n\n=== Long lines\n\nIf a statement is too long, continue it on the next line indented\ntwo levels deeper (but less or more is okay depending on the situation).\n\nBreak the line after an operator:\n\n[source,c]\n----\nint var = really really long expression +\n more of this expression;\n----\n\nAnd usually at an _outer_ element if possible, this could be the assignment\noperator itself.\n\n[source,c]\n----\nint var = (expr1 + expr2) *\n (expr3 + expr4);\n----\n\nSometimes line-breaking can be done nicely by naming a sub-expression,\ngive it a meaningful name:\n\n[source,c]\n----\nint sub_expr = some rather complex but separate expression;\nint var = foo(a + b, sub_expr);\n----\n\nYou may choose to align sub-expressions during breaking. This is\nrecommended when an expression is broken over several lines. Even though\n+name+ is short we give it its own line because the other expressions are\nlong.\n\n[source,c]\n----\nint var = fprintf(\"%s: %d, %s\\n\",\n name,\n some detailed and rather long expression,\n a comment);\n----\n\nWhen things that may need wrapping occur at different depths within an\nexpression then different levels of indentation can help convey that depth:\n\n[source,c]\n----\nint var = fprintf(\"%s: %d, %s\\n\",\n name,\n foo(some detailed and long expression,\n another detailed and long expression),\n a comment);\n----\n\nThese two sub-expressions are aligned, but they don't have to be (see Tables\nbelow).\n\nSometimes breaking early can allow you to align things towards the left and\ngive them more room. For example we prefer:\n\n[source,c]\n----\nstatic PZ_Proc_Symbol builtin_setenv = {\n PZ_BUILTIN_C_FUNC,\n { .c_func = builtin_setenv_func },\n false\n};\n----\n\nWhile clang-format prefers:\n\n[source,c]\n----\nstatic PZ_Proc_Symbol builtin_setenv = { PZ_BUILTIN_C_FUNC,\n {.c_func = builtin_setenv_func},\n false };\n----\n\n== Naming conventions\n\n=== Functions, function-like macros, and variables\n\nUse all lowercase with underscores to separate words. For instance,\n+soul_machine+.\n\n=== Enumeration constants, +#define+ constants, and non-function-like macros\n\nUse all uppercase with underscores to separate words. For instance,\nMAX_HEADROOM.\n\nTODO: Maybe make function-like macros belong here.\n\n=== Static data\n\nStatic data should begin with s_ for both file-local and class members.\n\n=== Typedefs\n\nUse first letter uppercase for each word, other letters lowercase and\nunderscores to separate words. For instance, Directory_Entry.\n\nNOTE: this is rarely used and might become the same as classes and structs.\n\n=== Structs and unions\n\nIf something is both a struct and a typedef, the name for the struct should\nbe formed by appending `_S' to the typedef name.\nThis overrides the style for typedefs above:\n\n[source,c]\n----\ntypedef struct DirectoryEntry_S {\n ...\n} DirectoryEntry;\n----\nFor unions, append `_U' to the typedef name.\n\n=== Classes\n\nClasses use CamelCaseWithInitialCap.\n\n=== Member data\n\nFields of classes (but not structs) should begin with m_, static data\nmembers should begin with s_.\n\n=== Constexpr functions and variables, and const variables.\n\nThese behave differently (better) than C macros. They don't need to look\nlike C macros. Use _ to seperate words with initial capital letters.\nEg: `My_Const_Expr'\n\n== Portability and Standards\n\nOur minimum requirements from the C and C++ environment is C99 (may move to\nC11 in the future) and C++11 on a POSIX.1-2008 environment,\nthis may change as dependencies are added in this early stage of development,\nhowever those changes should be carefully reviewed,\nand if possible they should be optional.\n\nDifferences between operating systems and the use of a tool like autoconf\nshould be handled by having different configurations available via different\nMakefiles and header files.\nWe will revisit this when development reaches that stage.\nAutoconf should be avoided, it brings only pain.\n\nWhile it's best to keep things portable, if you need a non-standard API, or\nan API that's different on each operating system. You should make it\navailable by a macro or protecting it by #ifdefs.\n\n=== Data types\n\nC99 provides many basic data types, +char+, +short+, +int+ etc. All being\ndefined to be at least a certain size.\nThese should be used when the size doesn't exactly matter. For example use\n+bool+ for booleans and +int+ or +unsigned+ when you're counting a _normal_\namount of something - you should not need to use the macros such as\n+INT_MAX+.\nWhen size matters the +inttypes.h+ types are strongly recommended, including\nthe _fast_ types, eg: +uint_fast32_t+ and their macros.\n\n+float+ should be used in preference to +double+ which is seldom necessary\nand uses more memory.\nDon't rely on exact IEEE-754 semantics.\n\nSince C99 does not specify the representation of signed values,\nwe will assume 2's complement arithmetic (we're not exactly C99 pure).\n\nEndianness and alignment must not be assumed.\nIf laying out a structure manually align each member based on its size.\n\n=== Operating system specifics\n\nOperating system APIs differ from platform to platform. Although most\nsupport standard POSIX calls such as +read+, +write+ and +unlink+, you\ncannot rely on the presence of, for instance, System V shared memory.\nAdhere to POSIX-supported operating system calls whenever possible\nsince they are widely supported, even by Windows.\n\nThe +CFLAGS+ variable in the +Makefile+ will request that modern C compilers\nfail to compile Plasma if it uses non-POSIX APIs.\n\n----\nCFLAGS=-std=c99 -D_POSIX_C_SOURCE=200809L -Wall -Werror\n----\n\nWhen POSIX doesn't provide the required functionality, ensure that the\noperating system specific calls are localised.\n\n=== Compiler and C library specifics\n\nWe require a C99 compiler. However many compilers often provide\nnon-standard extensions. Ensure that any use of compiler extensions is\nlocalised and protected by #ifdefs. Don't rely on features whose behaviour\nis undefined according to the C99 standard. For that matter, don't rely on C\narcana even if they are defined. For instance, +setjmp+/+longjmp+ and ANSI\nsignals often have subtle differences in behaviour between platforms.\n\nIf you write threaded code, make sure any non-reentrant code is\nappropriately protected via mutual exclusion. The biggest cause of\nnon-reentrant (non-thread-safe) code is function or module-static data. Note\nthat some C library functions may be non-reentrant. This may or may not be\ndocumented in the man pages.\n\n=== C++ portability/standards\n\nIn addition to sticking to C++11 (which is the minimum required for \"modern\nC++\").\nWe also forbid use of exceptions and RTTI, they're unnecessary and add too\nmuch magic.\nYou should also be frugal with templates and vtables.\nYou may follow guidelines for \"good C++\" from other sources,\nI've been reading the Essential C++ series and found it helpful.\n\n=== Library standards including C/C++ standard library\n\nIf you need a feature from a newer version of one of these standards, but we\ndon't have the need to upgrade our minimum dependencies and the new feature\nis a change you can easily add as a utility function. Then add it to\n+pz_cxx_future.h/cpp+ (or create a new future file for other libraries),\nand indicate in a comment what version of the standard they're from.\n\nThen when we do update our dependencies we can look in these files to\neasily find what workarounds we can remove.\n\nThis also applies to things that haven't been added to a standard but might\nbe someday.\n\n=== Environment specifics\n\nThis is one of the most important sections in the coding standard. Here we\nmention what other tools Plasma may depend on.\n\n==== Tools required for Plasma\n\nIn order to build Plasma you need:\n* A POSIX (1-2008) system/environment.\n* A shell compatible with Bourne shell (sh)\n* GNU make\n* A C99/C++11 compiler\n* Mercury 14.01.1 or newer.\n\n==== Documenting the tools\n\nIf further tools or libraries are required, you should add them to the above\nlist. And similarly, if you eliminate dependence on a tool, remove it from\nthe above list.\n\n== Syntax\n\nBasic layout (line length, indentation etc) is covered above in File\nencoding.\n\n=== General rules\n\nClang-format has been configured and mostly does the right thing. But often\ndoesn't. You could check \"what would clang-format do\" but it is not to be\nrelyed on.\n\n==== Curly brackets\n\nCurly brackets should be placed at the end of the opening line, and on a new\nline not-indented at the end:\n\n[source,c]\n----\nif (condition) {\n ...\n}\n----\n\nExcept for functions and classes, which should have the opening curly on a\nnew line.\n\n[source,c]\n----\nint\nfoo(arg)\n{\n ...\n}\n----\n\nIf the opening line is split between multiple lines, such as a long\ncondition in an if-then-else, then place the opening curly on a new line to\nclearly separate the condition from the body:\n\n[source,c]\n----\nif (this_is_a_somewhat_long_conditional_test(\n in_the_condition_of_an +\n if_then))\n{\n ...\n}\n----\n\n==== Space between tokens\n\nThere should be a space between the statement keywords like +if+, +while+,\n+for+ and +return+ and the next token. The return value should not be\nparenthesised. There should also be a space around an operator.\n\nThere should be no space between the function-like keywords like +sizeof+\nand their argument list. There also be no space between a cast and its\nargument.\n\n=== Pointer declarations\n\nPlace the pointer or reference qualifier between the type and the variable\nname.\n[source,c]\n----\nchar * str1, * str2;\n----\n\nThis avoids confusion that might occur when the pointer qualifier is\nattached to the type.\n[source,c]\n----\nchar* str1, not_really_a_str;\n----\n\nTODO: find out if the same trap exists for C++ references.\n\nAnd makes the symbol easier to notice.\n\n=== Statements\n\nUse one statement per line.\n\n==== Large control-flow statements\n\nUse an +// end + comment if the if statement, switch or loop is quite large,\nparticularly if there are multiple nested structures. It may be helpful to\ndescribe the condition of the branch in this comment.\n\n[source,c]\n----\nif (blah) {\n // Use curlies, even when there's only one statement in the block.\n ...\n // Imagine dozens of lines here.\n ...\n} // end if\n----\n\n==== Tiny control-flow structures\n\nAn exception to the above rule about always using curlies, is that an +if+\nstatement may omit the curlies if its body is a single +return+ or +goto+\ninstruction and is placed on the same line.\n\n[source,c]\n----\nfile = fopen(\"file.txt\", \"r\");\nif (NULL != file) goto error;\n----\n\nor\n\n[source,c]\n----\nfile = fopen(\"file.txt\", \"r\");\nif (NULL != file) {\n goto error;\n}\n----\n\nbut not:\n\n[source,c]\n----\nfile = fopen(\"file.txt\", \"r\");\nif (NULL != file)\n goto error;\n----\n\nand not:\n\n[source,c]\n----\nif (a_condition)\n do_action();\n----\n\nAdditionally, if one branch uses curlies then all must use curlies. Do not\nmix styles such as:\n\n[source,c]\n----\nif (a_condition) goto error;\nelse {\n do_something();\n}\n----\n\nAnd if the condition covers multiple lines, then the body must always appear\nwithin curlies (with the opening curly on its own line as noted above).\n\n[source,c]\n----\nif (0 == read_proc(file, imported, module, code_bytes,\n proc->code_offset, &block_offsets[i]))\n{\n goto end;\n}\n----\n\n==== Conditions\n\nTODO: Consider removing this rule.\n\nTo make clear your intentions, do not rely on the zero / no-zero boolean\nbehaviour of C. This means explicitly comparing a value:\n\n[source,c]\n----\nif (NULL != file) goto error\n----\n\nIf using the equality operator +==+, use a non-_lvalue_ on the\nleft-hand-side if possible.\nThis way the comparison can not be mistaken for an assignment.\n\n[source,c]\n----\nif (0 == result) {\n ...\n}\n----\n\n==== Switch statements\n\nCase labels should be indented one level, which will indent the body by two\nlevels.\n\nSwitch statements should usually have a default case, even if it just calls\n+abort()+.\nIf the switched-on value is an enum, the default may be omitted since the\ncompiler will check that all the possible values are covered.\n\n==== Fall through switch cases\n\nIf a switch case falls through, add a comment to say that this is\ndeliberately intended.\n\n[source,c]\n----\nswitch (var) {\n case A:\n ...\n break;\n case B:\n ...\n // fall-through\n case C:\n ...\n break;\n}\n----\n\n==== Curlies in cases\n\nIf a case requires local variable declarations, place the curlies like\nthis:\n\n[source,c]\n----\n ...\ncase A: {\n int foo;\n ...\n break;\n}\ncase B:\n ...\n----\n\n==== Loops\n\nLoops that end in a non-obvious way, such as infinite while loops that use\n'break' to end the loop. Should be documented. You'll need to use\njudgement about when this is needed.\n\n[source,c]\n----\n// Note that the loop will exit when ...\nwhile (true) {\n ...\n if (some condition)\n break;\n ...\n}\n----\n\nor\n\n[source,c]\n----\nwhile (everything_is_okay) {\n ...\n if (some condition) {\n // Exit the loop on the next iteration.\n everything_is_okay = false;\n }\n ...\n}\n----\n\n=== Functions\n\nIn argument lists, put space after commas. Include parameter names in the\ndeclaration as this can aid in documentation.\n\nUnlike other code blocks, the open-curly for a function should be placed on\na new line.\n\n[source,c]\n----\nint rhododendron(int a, float b, double c)\n{\n ...\n}\n----\n\nIf the parameter list is very long, then you may wish, particularly for long\nor complex parameter lists, place each parameter on a new line aligning them.\nAligning names as in variable definition lists is also suggested but not\nrequired.\n\n[source,c]\n----\nint rhododendron(int a_long_parameter,\n struct AComplexType* b,\n double c)\n{\n ...\n}\n----\n\n=== Variables\n\nVariable declarations shouldn't be flush left, however.\n[source,c]\n----\nint x = 0,\n y = 3,\n z;\n----\n\n----\nint a[] = {\n 1,2,3,4,5\n};\n----\n\nWhen defining multiple variables or structure fields or in some cases\nfunction parameters, then lining up their names is recommended.\nThis also applies to structure and union fields.\n\nThere should be one line of vertical space between the definition list and\nthe next statement.\n\n[source,c]\n----\nchar * some_string;\nint x;\nMyStructure * my_struct;\n\nif (...) {\n----\n\n=== Enums or defines?\n\nPrefer enums to lists of #defines. Note that enums constants are of type\nint, hence if you want an enumeration of chars or shorts, then you must\nuse lists of #defines.\n\n=== Preprocessing\n\n==== Nesting\n\nNested #ifdefs, #ifndefs and #ifs should be indented by two spaces for each\nlevel of nesting. For example:\n\n[source,c]\n----\n#ifdef GUAVA\n #ifndef PAPAYA\n #else // PAPAYA\n #endif // PAPAYA\n#else // not GUAVA\n#endif // not GUAVA\n----\n\n==== Multi-line macros\n\nWhen continuing a macro on an new line, line the +\\+ up o the right in the\nsame column.\n\n[source,c]\n----\n#define PZ_WRITE_INSTR_1(code, w1, tok) \\\n if (opcode == (code) && width1 == (w1)) { \\\n token = (tok); \\\n goto write_opcode; \\\n }\n----\n\n== Other implementation choices\n\n=== C++ Class or Struct\n\nIf a thing will have methods that act on instances, it is a class and should\nbegin with the \"class\" keyword, and keep its data members private.\nOtherwise it is a struct and shell begin with a struct keyword..\n\n=== Bare Pointers\n\nBare pointers aren't \"modern C\\+\\+\".\nHowever in Plasma's runtime system they show that the lifetime of the object\nis handled elsewhere.\nEither it is known to live a very long time and live in static data or on\nthe C++ heap and destroyed when the program ends.\nOr it is a GC allocated object and we additionally guarantee that in the time\nwhile it's live (passed around) it's impossible for a GC to occur (there's\nalso a NoGCScope present.\n\nTODO: Describe how we root GC pointers within runtime code.\n\n=== C++ information hiding\n\nC++ exposes implementation details of classes in their declarations as\nprivate members.\nThis means that changes to these internal details can cause unnecessary\nrecompilation.\nOn the other hand it allows the compiler to inline functions defined in the\nclass definition that _do_ access private members.\n\nWhen the latter need is not great it can be good to avoid creating the\nformer problem by hiding these details. There are a few different\ntechniques\n\nThe *pImpl* pattern is done where the class now contains a pointer to a\nclass that contains the actual implementation. This pointer should be a\n+std::shared_ptr+ and the outer class is expected to be passed by value\nrather than by reference.\nWhile this still allows callers to use +object.method()+ style calls (which\nthen forward), it breaks the normal expectations where \"most objects should\nbe passed by reference\". Of course you _can_ pass them by reference but\ndoing so creates an extra pointer indirection.\nPassing by value isn't great either, causing extra work in the\n+std::shared_ptr+ to maintain its reference count.\n\nThere's *another pattern* where an abstract base class contains a virtual\npublic interface and a private derived class containing the actual\nimplementation.\nWe avoid this because we want to avoid vtables when we can.\n\nTherefore the *pattern we use* in Plasma's runtime (when we choose to hide\nimplementation details at all) is to forward declare the class, and define\nit in an implementation file or implementation-only header file.\nThe public interface is defined as non-member forwarding functions.\nThis pattern can be seen in\nhttps://github.com/PlasmaLang/plasma/blob/master/runtime/pz_gc.h[+pz_gc.h+] and\nhttps://github.com/PlasmaLang/plasma/tree/master/runtime/pz_gc.impl.h[+pz_gc.impl.h+].\n\n== Comments\n\n=== What should be commented\n\n==== Functions\n\nUse your judgement for whether a function should be commented.\nSometimes the function name and parameter names will provide a lot of\ninformation.\nHowever for more complex functions a comment will be necessary.\nComments are strongly recommended when:\n\n* They have side-effects\n* They require an input to be sorted, non-null or similar.\n* They have different semantics when an input has a different value\n (they should be separate functions if they do a different _function_).\n* They allocate memory that the caller is now responsible for.\n* They return statically allocated memory (try to avoid this).\n* They free memory.\n* They return certain values (non-zero, -1 etc) for errors.\n* They ain't thread safe or reenterant.\n\n==== Macros\n\nEach non-trivial macro should be documented just as for functions (see\nabove). It is also a good idea to document the types of macro arguments and\nreturn values, e.g. by including a function declaration in a comment.\n\nParameters to macros should be in parentheses.\n\n[source,c]\n----\n#define STREQ(s1,s2) (strcmp((s1),(s2)) == 0)\n----\n\nThis ensures than when a complex expression is passed as a parameter that\ndifferent operator precedence does not affect the meaning of the macro.\n\n==== Headers\n\nSuch function comments should be present in header files for each function\nexported from a source file. Ideally, a client of the module should not have\nto look at the implementation, only the interface. In C terminology, the\nheader should suffice for working out how an exported function works.\n\n==== Source files\n\nEvery source file should have a prologue comment which includes:\n\n* Copyright notice.\n* License info\n* Short description of the purpose of the module.\n* Any design information or other details required to understand and maintain\n the module (may be links to other documents).\n\n[TODO]\n====\nDescribe the exact format in use and ensure that all the C code\nconforms to this.\n====\n\n==== Global variables\n\nAny global variable should be excruciatingly documented. This is especially\ntrue when globals are exported from a module. In general, there are very few\ncircumstances that justify use of a global.\n\n=== Comment style\n\n==== Block comments.\n\nUse comments of this form:\n[source,c]\n----\n/*\n * This is a block comment,\n * it uses multiple lines.\n * It should have a blank line before it and it comments the declaration,\n * definition, block or group of statements immediately following it.\n */\n----\n\nFor annotations to a single line of code:\n[source,c]\n----\ni += 3; // Add 3.\n----\n\nNote that the +//+ comment is standard in C99, which we are using.\nIf the comment fits on one line, even if it describes multiple lines, a\nsingle line comment is okay:\n[source,c]\n----\n// Add 3.\ni += 3;\n----\n\nHowever if the comment is important, or the thing it documents is\nsignificant. Then use a block comment.\n\n=== Guidelines for comments\n\n==== Revisits\n\nAny code that needs to be revisited because it is a temporary hack (or some\nother expediency) must have a comment of the form:\n[source,c]\n----\n/*\n * XXX: \n * - \n */\n----\nThe should explain the problem in a way that can be\nunderstood by developers other than the author of the comment.\nAlso include the author of this comment so that a reader will know who to\nask if they need further information.\n\n\"TODO\" and \"Note\" are also common revisit labels. Only \"XXX\" _requires_ the\nauthor's name.\n\n==== Comments on preprocessor statements\n\nThe +#ifdef+ constructs should be commented like so if they extend for more\nthan a few lines of code:\n[source,c]\n----\n#ifdef SOME_VAR\n ...\n#else // ! SOME_VAR\n ...\n#endif // ! SOME_VAR\n----\n\nSimilarly for +#ifndef+.\nUse the GNU convention of comments that indicate whether the variable is\ntrue in the +#if+ and +#else+ parts of an +#ifdef+ or +#ifndef+. For\ninstance:\n\n[source,c]\n----\n#ifdef SOME_VAR\n#endif // SOME_VAR\n\n#ifdef SOME_VAR\n ...\n#else // ! SOME_VAR\n ...\n#endif // ! SOME_VAR\n\n#ifndef SOME_VAR\n ...\n#else // SOME_VAR\n ...\n#endif // SOME_VAR\n----\n\n== Using formatting tools\n\nTyping `make format` will run clang-format-10 on the C/C++ code. It\nmis-formats quite a few things so we don't yet use it automatically, or may\ndo on a file-by-file basis some time.\n\n=== Tables\n\nWhen code or data is tabular then using a tabular layout makes the most\nsense. This may be something formatters cannot handle, some will allow you\nto describe excisions.\n\nWe don't have a good example of this in the code base,\nhowever the data in +pz_builtin.c+ could probably be set out in a table.\nIf it were it might look like:\n\n[source,c]\n----\nstatic PZ_Proc_Symbol builtins[] = {\n { PZ_BUILTIN_C_FUNC, {.c_func = builtin_setenv_func}, false },\n { PZ_BUILTIN_C_FUNC, {.c_func = builtin_free_func}, false }\n};\n----\n\n== Defensive programming\n\n=== Asserts and debug builds\n\nTODO\n\n=== Statement macros must be single statements\n\nMacros should either be expressions (they have a value) or statements (they\ndo not), this must always be clear. If necessary make a single statement\nusing a block. The\nhttps://gcc.gnu.org/onlinedocs/cpp/Swallowing-the-Semicolon.html[do {} while (0)]\npattern is not necessary since bodies of if statments may not be macros\nwithout their own curly brackets.\n\n[source,c]\n----\n#define PZ_WRITE_INSTR_1(code, w1, tok) \\\n if (opcode == (code) && width1 == (w1)) { \\\n token = (tok); \\\n goto write_opcode; \\\n }\n----\n\n=== Macros should not evaluate parameters more than once\n\nC expressions may have side-effects, this is okay most of the time but can\nlead to confusion with macros. A macro can evaluate its parameters more\nthan once. Avoid doing this in your macros, and if you must add a comment\nexplaining that this can happen.\n\n=== C++ type conversion\n\nIt's very easy for C++ compilers to want to perform type conversions for\nyou. This is frequently done via conversion operators and constructions\nthat take a single argument. The later are easy to provide by mistake,\ntherefore 1-arg constructors should be declared as explicit, which will\nprevent the compiler from using them automatically.\n\n----\nexplicit MyType(const OtherType &other);\n----\n\nWhen implicit conversion is desired, add a comment to tell anyone reading your\ncode that you didn't forget, that you _want_ it to be implicit.\n\n----\n// Implicit constructor\nOptional(T &other);\n----\n\n=== C++ copy constructors\n\nC++ will create implicit copy constructors. These don't always do the right\nthing so it is best to either create them explicitly or tell C++ you don't\nwant them. The same is true for copy assignment operators.\n\n----\nMyClass(const MyClass &) = delete;\nvoid operator=(const MyClass &) = delete\n----\n\n== Tips\n\n* Limit module exports to the absolute essentials. Make as much static (that\n is, local) as possible since this keeps interfaces to modules simpler.\n* Use typedefs to make code self-documenting. They are especially useful on\n structs, unions, and enums. Use them on the struct or union's forward\n declaration or header declaration when the definition is provided\n elsewhere.\n\n== Tracing macros\n\nTODO\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/dev_style_mercury.txt", "content": "Plasma Development Mercury Style Guide\n======================================\n:Author: Gert Meulyzer\n:Email: gert@plasmalang.org\n:Date: September 2015\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\n// For the Mercury style guide:\n// https://mercurylang.org/development/developers/coding_standards.html\n// and for reference:\n// https://mercurylang.org/development/developer.html\n\n== General Project Contributing Guide\n\nFor general information about contributing to Plasma please\nsee\nlink:contributing.html[our contributors' documentation].\n\n== Documentation\n\n\n* Each module should contain header comments which state the module's name,\n a copyright notice, license info, main author(s), and purpose, and give an\n overview of what the module does, what are the major algorithms and data\n structures it uses, etc.\n\n* Everything that is exported from a module should have sufficient \ndocumentation that it can be understood without reference to the module's\nimplementation section.\n\n* Each predicate other than trivial access predicates should have a short comment describing what the predicate is supposed to do, and what the meaning of the arguments are. Ideally this description should also note any conditions under which the predicate can fail or throw an exception.\n\n* There should be a comment for each field of a structure saying what the field represents.\n\n== Naming\n\n* Variables should always be given meaningful names, unless they are irrelevant to the code in question. For example, it is OK to use single-character names in an access predicate which just sets a single field of a structure, such as:\n\n----\nbar_set_foo(Foo, bar(A, B, C, _, E), bar(A, B, C, Foo, E)).\n----\n\n* Variables which represent different states or different versions of the same entity should be named Foo0, Foo1, Foo2, ..., Foo.\n* Predicates which get or set a field of a structure or ADT should be named bar_get_foo and bar_set_foo respectively, where bar is the name of the structure or ADT and foo is the name of the field.\n\n== Coding\n\n* Your code should make as much reuse of existing code as possible. \"cut-and-paste\" style reuse is highly discouraged.\n\n* No fixed limits please! (If you really must have a fixed limit, include detailed documentation explaining why it was so hard to avoid.)\n\n== Error handling\n\n* Code should check for both erroneous inputs from the user and also invalid\n data being passed from other modules. You should also always check to make\n sure that the routines that you call have succeeded; make sure you don't\n silently ignore failures. (This last point almost goes without saying in\n Mercury, but is particularly important to bear in mind if you are writing\n any C code or shell scripts, or if you are interfacing with the OS.)\n\n* Error messages should follow a consistent format. For compiler error\n messages, each line should start with the source file name and line number\n in \"%s:%03d: \" format. Error messages should be complete\n sentences. For error messages that are spread over more than one line (as\n are most of them), the second and subsequent lines should be indented two\n spaces.\n\n* Exceptions should usually be used for *exceptional* (eg unforeseen)\n things. However during early development exceptions are a suitable way to\n mark something that we intend to fix later. There are four types of\n exception used.\n\n** +software_error+ (thrown by +unexpected+ and +error+). This is used when\n something truly unanticipated has occurred, such as an assertion of a state\n that should never happen.\n\n** +compile_error_exception+ (thrown by +compile_error+). This is used when\n a compilation error is not properly handled. These should be converted\n to actual compiler errors in the future.\n\n** +unimplemented_exception+ (thrown by +sorry+). This is used when\n a Plasma feature is not implemented yet. It is a case that we intend to\n handle in the future.\n\n** +design_limitation_exception+ (thrown by +limitation+). This is used when\n some limitation is exceeded. These are thing that we think will never\n happen, and so have no plans to fix them. If they do happen, then we\n will attempt to fix them.\n\n== Layout\n\n* Each module should be indented consistently, with 4 spaces per level of\n indentation. The indentation should be consistently done with spaces.\n A tab character should always mean 4 spaces.\n Never under any circumstances mix tabs and spaces.\n\n Currently 100% of our development is done in vim, therefore it is trivial\n to use an editor hint to encourage this. Files should have something like\n this at the top, even before the copyright line:\n\n----\n\t% vim: ft=mercury ts=4 sw=4 et\n----\n\n Hints for other editors should be added as necessary.\n\n* No line should extend beyond 77 characters. We choose 77 characters to\n allow for one character to be used when creating diffs and two more\n characters to be used in e-mail replies duing code review.\n\n* Since \"empty\" lines that have spaces or tabs on them prevent the proper functioning of paragraph-oriented commands in vi, lines shouldn't have trailing white space. They can be removed with a vi macro such as the following. (Each pair of square brackets contains a space and a tab.)\n----\n\tmap ;x :g/[ ][ ]*$/s///^M\n----\n\n* String literals that don't fit on a single line should be split by writing them as two or more strings concatenated using the \"++\" operator; the Mercury compiler will evaluate this at compile time, if --optimize-constant-propagation is enabled (i.e. at -O3 or higher).\n\n* Predicates that have only one mode should use predmode declarations rather than having a separate mode declaration.\n\n* If-then-elses should always be parenthesized, except that an if-then-else that occurs as the else part of another if-then-else doesn't need to be parenthesized. The condition of an if-then-else can either be on the same line as the opening parenthesis and the `->',\n\n----\n\t( test1 ->\n\t\tgoal1\n\t; test2 ->\n\t\tgoal2\n\t;\n\t\tgoal\n\t)\n----\n\nor, if the test is complicated, it can be on a line of its own:\n\n----\n\t(\n\t\tvery_long_test_that_does_not_fit_on_one_line(VeryLongArgument1,\n\t\t\tVeryLongArgument2)\n\t->\n\t\tgoal1\n\t;\n\t\ttest2a,\n\t\ttest2b,\n\t->\n\t\tgoal2\n\t;\n\t\ttest3\t% would fit one one line, but separate for consistency\n\t->\n\t\tgoal3\n\t;\n\t\tgoal\n\t).\n----\n\n* Disjunctions should always be parenthesized. The semicolon of a disjunction should never be at the end of a line -- put it at the start of the next line instead.\n\n* Normally disjunctions place each semicolon on a new line\n\n----\n (\n goal1,\n goal2\n ;\n goal3\n ;\n goal4,\n goal5\n ).\n----\n\n* However simple disjunctions, such as those that attempt to unify a\n variable in each disjunct (which are also switches), may be formatted more\n concicely.\n\n----\n ( goal1\n ; goal2\n ; goal3\n ),\n----\n\n* Switches may be formatted with the switched on variable sharing a line\n with the open-paren and each semicolon:\n\n----\n ( X = foo,\n goal1,\n goal2\n ; X = bar,\n goal3\n ).\n----\n\n Or the switched on variable may have a line of its own, as it would in a\n regular disjunction.\n\n* Predicates and functions implemented via foreign code should be formatted like this:\n\n----\n:- pragma foreign_proc(\"C\",\n to_float(IntVal::in, FloatVal::out),\n [will_not_call_mercury, promise_pure],\n\"\n FloatVal = IntVal;\n\").\n----\n\n* The predicate name and arguments should be on a line on their own, as should the list of annotations. The foreign code should also be on lines of its own; it shouldn't share lines with the double quote marks surrounding it.\n* Type definitions should be formatted in one of the following styles:\n\n----\n :- type my_type\n ---> my_type(\n some_other_type % comment explaining it\n ).\n\n\t:- type some_other_type == int.\n\n :- type foo\n ---> bar(\n int, % comment explaining it\n float % comment explaining it\n )\n ; baz\n ; quux.\n----\n\n* If an individual clause is long, it should be broken into sections, and each section should have a \"block comment\" describing what it does; blank lines should be used to show the separation into sections. Comments should precede the code to which they apply, rather than following it.\n\n----\n\t%\n\t% This is a block comment; it applies to the code in the next\n\t% section (up to the next blank line).\n\t%\n\tblah,\n\tblah,\n\tblahblah,\n\tblah,\n----\n\nIf a particular line or two needs explanation, a \"line\" comment\n\n----\n\t% This is a \"line\" comment; it applies to the next line or two\n\t% of code\n\tblahblah\nor an \"inline\" comment\n\tblahblah\t% This is an \"inline\" comment\n----\n\nshould be used.\n\n== Structuring\n\n* Code should generally be arranged so that procedures (or types, etc.) are listed in top-down order, not bottom-up.\n* Code should be grouped into bunches of related predicates, functions, etc., and sections of code that are conceptually separate should be separated with dashed lines:\n\n----\n%---------------------------------------------------------------------------%\n----\n\nIdeally such sections should be identified by \"section heading\" comments identifying the contents of the section, optionally followed by a more detailed description. These should be laid out like this:\n\n----\n%---------------------------------------------------------------------------%\n%\n% Section title\n%\n\n% Detailed description of the contents of the section and/or\n% general comments about the contents of the section.\n% This part may go one for several lines.\n%\n% It can even contain several paragraphs.\n\nThe actual code starts here.\n----\n\nFor example\n\n----\n%---------------------------------------------------------------------------%\n%\n% Exception handling\n%\n\n% This section contains all the code that deals with throwing or catching\n% exceptions, including saving and restoring the virtual machine registers\n% if necessary.\n%\n% Note that we need to take care to ensure that this code is thread-safe!\n\n:- type foo\n ---> ...\n\n----\n\nDouble-dashed lines, i.e.\n\n----\n%---------------------------------------------------------------------------%\n%---------------------------------------------------------------------------%\n----\n\ncan also be used to indicate divisions into major sections. Note that these\ndividing lines should not exceed the 77 character limit (see above).\n\n== Module imports\n\n* Each group of :- import_module items should list only one module per line,\n since this makes it much easier to read diffs that change the set of\n imported modules. In the compiler, when e.g. an interface section imports\n modules from from the same program (the compiler) and other libraries,\n there should be two groups of imports, the imports from the program first\n and then the ones from the libraries.\n* Each group of import_module items should be sorted, since this makes it\n easier to detect duplicate imports and missing imports. It also groups\n together the imported modules from the same package. There should be no\n blank lines between the imports of modules from different packages, since\n this makes it harder to resort the group with a single editor command.\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/dev_testing.txt", "content": "Plasma Test Suite\n=================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: September 2022\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nThe Plasma test suite is located under tests/ but will also execute programs\nin examples/ to ensure they keep working.\n\nSee tests/README.md for a description of the directory tree.\n\n== Running tests\n\nThe test script looks for tests in the directories on its command line.\n\n $ ./tests/run-tests.lua examples tests\n\nWill execute all the tests in the examples and tests directories.\n\n== Adding a new test\n\nThe test script searches for tests by looking for `*.exp` files within the\n`tests/` and `examples/` directories and their sub-directories.\n\nAll tests have an `*.exp` file, this is the \"expected output\" of the test,\nwhat exactly \"output\" means depends on the type of the test.\n\n=== Ordinary tests\n\nThe test script will attempt to build and run these tests by either finding\na `.build` file with the same name as the test (eg if `my_test.exp` exists\nthen the script will look for `my_test.build`), or use a `BUILD.plz` file in\nthe same directory which may be shared with multiple tests (see the\n`examples/` directory.)\n\nOnce build the test script will expect to run a bytecode file with the same\nname, eg `my_test.pz`. It will run the test, optionally with input from a\n`my_test.in` file, and check the output against the expected output.\n\nFor example for `my_test.exp` it will\ntry to build/find `my_test.pz`. It will then run this file and gather the\noutput. The test passes if exits with 0 for its exit code AND its output\nmatches the contents of the `*.exp` file.\n\nTest output may include lines beginning with #, these will be ignored when\ncomparing with the expected output.\n\n=== compile_failure tests\n\nThese tests will attempt to compile a program (using a matching `.build`\nfile) and compare the compiler's output with the expected output. A test\ncan be made a `compiler_failure` test using a test configuration line to\nspecify the type as below.\n\n== Test configuration\n\nFor each test the test script looks in the .p file to find lines containing\n`PLZTEST`. The next two whitespace seperated tokens on that line are\nconfiguration paramter and its value. For example:\n\n // PLZTEST build_type dev\n\nSets the `build_type` parameter to `dev`.\n\nThe recognised parameters are:\n\n**`build_type`**: Either `dev` or `rel`. In which build should this test be\nexecuted. If not set then the test runs in all builds. This is the same\nbuild type as set in `build.mk`.\n\n**`build_args`**: Arguments to pass to plzbuild during the build step of the\ntest.\n\n**`returns`**: The expected exit code for a passing test. The default is 0.\n\n**`output`**: Which stream contains the output we wish to capture and compare.\n`stdout` (the default) or `stderr`.\n\n**`type`**: If specified it must be set to compile\\_failure which\nindicates that the build step must fail and return the exit code 1 and the\noutput of the compiler will be checked against the expected output file.\nIf the test type is unspecified it defaults to 'run' (aka ordinary tests).\n\n=== Building tests\n\nThe script will attempt to build tests by checking for a `BUILD.plz` file in\nthe same directory. If it finds one it knows it can build the test by\nexecuting `plzbuild` in that directory. It passes this step if plzbuild\nexits with 0.\n\n== Other rules\n\n * Don't name your test \"plzbuild\" that is reserved.\n\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/getting_started.txt", "content": "Getting started with Plasma\n===========================\n:Author: Paul Bone \n:Email: paul@plasmalang.org\n:Date: Janurary 2023\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nSince we don’t have static builds yet, you’ll need to build Plasma from source.\nThis file contains some instructions on setting up the prerequisites and\nbuilding Plasma.\n\nPlasma has been tested on Linux, Windows subsystem for Linux 1 and 2 on x86_64.\n\n\n== Docker\n\nIf you want to run Plasma in a Docker container (rather than the\ninstructions below for Ubuntu Linux) the Dockerfile provided in\nhttps://github.com/PlasmaLang/plasma/tree/master/scripts/docker[scripts/docker] is available,\nIt is also build and available on\nhttps://hub.docker.com/r/paulbone/plasma-dep[docker hub].\nYou can resume this \"getting started\" guide at the\nxref:_hello_world[Hello World] section below,\nyou will still need to adapt some of the instructions for use with the\ncontainer.\n\n== Dependencies\n\nYou will need\n\n * GCC or Clang\n * GNU Make\n * git\n * Mercury (tested with 22.01)\n * ninja 1.10 or later\n\nOptionally for building documentation:\n\n * asciidoc\n * source-highlight\n\nOptionally to run the test suite:\n\n * lua\n * lua-file-system\n * lua-posix\n * diffutils\n * ncurses\n\n=== C++ compiler, make and git \n\nPlasma has been tested with clang and gcc.\nOn debian-based systems you can install a suitable compiler and GNU Make\nwith the build-essential package.\nInstall git at the same time.\n\n[source,bash]\n----\nsudo apt install build-essential git\n----\n\n=== Mercury\n\nYou’ll need another language, Mercury, since our compiler is written in it.\nA recent stable version is required (22.01.x), ROTD versions may also work.\nPlasma's CI currently tests with 22.01.\nCompiling Mercury from source can take a long time,\nbut if you’re on Debian, Ubuntu or other derivative running on x86_64\nthen there are some packages!\nRead on or follow the instructions at https://dl.mercurylang.org/deb/\n\n==== For Ubuntu 20.04, this is what you need to do:\n\nTo install Mercury you'll need to add a new package repository & GPG key.\nDownload and trust Paul's GPG key:\n\n[source,bash]\n----\ncd /tmp\nwget https://paul.bone.id.au/paul.asc\nsudo cp paul.asc /etc/apt/trusted.gpg.d/paulbone.asc\n----\n\nCreate a new file in /etc/apt/sources.list.d, name it mercury.list and paste\nin it:\n\n deb http://dl.mercurylang.org/deb/ focal main\n deb-src http://dl.mercurylang.org/deb/ focal main\n\nYou may need to substitue focal for another name, see the\nhttps://dl.mercurylang.org/deb/[Mercury debian packages page].\n\n.Now we can install:\n[source,bash]\n----\nsudo apt update\nsudo apt install mercury-rotd-recommended\n----\n\n=== Asciidoc\n\nTo optionally build the documentation, you need to install AsciiDoc and\nsource-highlight:\n\n[source,bash]\n----\nsudo apt install asciidoc source-highlight\n----\n\nBeware, this is a very large installation, on a default Ubuntu installation\nthis amounts to over 1 GB of space and a download of over 300MB.\nIf AsciiDoc is not installed, documentation will not be built.\n\n=== ninja\n\nPlasma's build tool `plzbuild` needs least version 1.10 of the ninja build\ntool.\n\nUbuntu 20.04 has a suitable package.\n\n----\nsudo apt install ninja-build\n----\n\nOr install it yourself from a binary download:\nhttps://github.com/ninja-build/ninja/releases\n\nOr from source:\nhttps://github.com/ninja-build/ninja/\n\nOr run these commands to install ninja 1.10.2 on your x86_64 Linux system:\n\n----\ncd /tmp\nwget https://github.com/ninja-build/ninja/releases/download/v1.10.2/ninja-linux.zip\nunzip ninja-linux.zip\nsudo cp ninja /usr/local/bin/\n----\n\nAlpine Linux doesn't currently contain a recent enough version, you'll need to\nbuild ninja from source on Alpine.\n\n=== Lua, diffutils and ncurses\n\nTo run the test suite you will need\n\n * lua\n * lua-file-system\n * lua-posix\n * diffutils\n * ncurses\n\nUbuntu 20.04 has a suitable package.\n\n----\napt install lua5.3 lua-filesystem lua-posix diffutils ncurses-bin\n----\n\n== Compiling Plasma\n\nNow it’s time to clone the plasma repo:\n\n[source,bash]\n----\ngit clone https://github.com/PlasmaLang/plasma.git\n----\nIf you want or need to, you can configure Plasma's build settings by\ncopying `template.mk` to `build.mk` and editing it.\nIt contains some documentation for the build options.\nThese include which C compiler to use, and compilation flags.\nThe default build is reasonable if you have `gcc`.\nYou may need to set the `PREFIX` variable to your desired installation\ndirectory, The Plasma compiler and other tools will be installed to\n`$PREFIX/bin/`, you will need to arrange for that to be in your shell\ninterpreter's path \n(https://github.com/PlasmaLang/plasma/issues/325[bug #325] will remove this\nrequirement).\n\nThen run `make` and it will build you the plasma compiler (`src/plzc`)\nand the runtime (`runtime/plzrun`).\nSet `MAKEFLAGS` to build the C++ code in parallel, or set it in your\n`~/.bashrc`.\n\n----\nNPROC=$(nproc)\nexport MAKEFLAGS=\"-j$NPROC -l$NPROC\"\nmake\n----\n\nThe `make test` command will execute the test suite.\nBe sure to take a look at the example programs in \nhttps://github.com/PlasmaLang/plasma/tree/master/examples[`examples/`].\n\n== Installing Plasma\n\nThe `make install` command will now install the Plasma tools into\nthe `$PREFIX` path you set in `build.mk` in the previous step.\nThe compiler and other tools are now available under `$PREFIX/bin/`.\n\nEnjoy!\n\n== Hello world\n\nSo you've got Plasma installed, it's time to take it for a test-drive.\n\nIn a new directory create a `BUILD.plz` project file, it should contain:\n\n----\n[hello]\ntype = program\nmodules = [ Hello ]\n----\n\nCreate a `hello.p` file to contain the `Hello` module, it should contain:\n\n----\nmodule Hello\n\nentrypoint\nfunc hello() uses IO -> Int {\n print!(\"Hello world\\n\")\n\n return 0\n}\n----\n\nThen use the `plzbuild` program to build the program:\n\n----\n$ plzbuild\n----\n\nThis will create a `hello.pz` file in the current directory containing the\nprogram's bytecode. Run it with:\n\n----\n$ plzrun hello.pz\nHello world\n----\n\n== vim customisation\n\nIf you want to write some Plasma programs and you use vim. You may wish to\nuse the\nhttps://github.com/PlasmaLang/vim[vim editor support].\n\n== Getting help\n\nIf you're stuck and the https://plasmalang.org/docs/[Documentation] doesn't\ncontain the answer or clue you need or you're struggling to find it. Please\nask for help.\nThe https://plasmalang.org/contact.html[Contact] page of the website lists\nall the ways you can get in touch.\nIn particular the\nhttps://plasmalang.org/lists/listinfo/help[Plasma Help mailing list]\nand\nhttps://discord.gg/x4g83w7tKh[Discord server] are the best\nresources for help.\n\nFor bugs or missing information please\nhttps://github.com/PlasmaLang/plasma/issues/new[file a bug].\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/index.txt", "content": "Plasma Language Documentation\n=============================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: March 2021\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n\nlink:getting_started.html[Getting Started with Plasma]::\n The getting started guide is your first step to working with Plasma. It\n covers installation, writing your first program, and where to look next.\n\nlink:user_guide.html[User's Guide]::\n The user's guide describes how to use the Plasma tools to work with your\n programs.\n\nlink:plasma_ref.html[Plasma Language Reference]::\n The language reference documents the language in a reference-style.\n It's useful if you want to lookup some detail. It's not a guide and not\n ideal for teaching the language. We have guide-like documentation other\n than the getting started guide.\n\nlink:contributing.html[Contributing to Plasma]::\n Information about contributing to Plasma. This covers necessary stuff\n like your first pull request but also links to further information like\n nitty-gritty compiler internals.\n\nlink:https://plasmalang.org/about.html#Publications[Publications]::\n List of publications.\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/plasma_ref.txt", "content": "Plasma Language Reference\n=========================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: January 2025\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nAs the language is under development this is a working draft.\nMany choices may be described only as bullet points.\nAs the language develops these will be filled out and terms will be\nclarified.\n\n== Lexical analysis and parsing\n\nThe \"front end\" passes of Plasma compilation work as follows:\n\n* Tokenisation converts a character stream into a token stream.\n* Parsing converts the token stream into an AST.\n* AST->Core transformation converts the AST into the core representation.\n This phase also performs symbol resolution, converting textual identifiers\n in the AST into unique references.\n\n=== Lexical analysis\n\n* Input files are UTF-8\n* Comments begin with a +//+ and extend to the end of the line, or are\n delimited by +/\\*+ and +\\*/+ and may cover multiple lines.\n Note that comments ending in +**/+ aren't currently supported as they confuse\n our limited tokeniser.\n* Curly braces for blocks/scoping\n* Whitespace is only significant when it separates two tokens what would\n otherwise form a single token\n* Statements and declarations are not delimited. The end of a statement can\n be determined by the statement alone. Therefore: there are no statement\n terminators or separators (such as semicolons in C) nor significant\n whitespace (as in Python or Haskell).\n* String constants are surrounded by double quotes and may contain the\n following escapes. +\\n \\r \\t \\v \\f \\b \\\\+. Escaping the double quote\n character is not currently supported, using character codes is not\n currently supported. Escaping any other character prints that character\n as is; this allows +\\'+ to work as many programmers may expect, even\n though it's not necessary.\n\n=== Parsing\n\nPlasma's grammar is given in pieces throughout this document as concepts are\nintroduced.\nHowever the top level and some shared definitions are given here.\nIn the grammar definitions I use ( and ) to denote groups and ? + and * to\ndenote optional, one or more, and zero or more.\n\n----\nPlasma := ModuleDecl ToplevelItem*\n\nToplevelItem := ImportDirective\n | TypeDefinition\n | ResourceDefinition\n | FuncDefinition\n | Pragma\n\nModuleQualifiers := ( ident . )*\nQualifiedIdent := ModuleQualifiers ident\n\nIdentList := ident ( , ident )*\nQualifiedIdentList := QualifiedIdent ( , QualifiedIdent )*\n----\n\n=== A note on case and style.\n\nIt is desirable to use case to distinguish symbols in different namespaces\nthat may appear in the same expression. It should never be required since\nthere are scripts that do not have a notion of case.\nThis is the suggested convention:\n\n|===\n| | Suggestion | Notes\n| Variable | lower_case |\n| Function Name | lower_case |\n| Module Name | UpperCase | Case insensitive\n| Type Name | UpperCase |\n| Type Variable | lower_case | will use the +'+ sigil to disambiguate\nfrom types\n| Data constructor | UpperCase | to distinguish construction from function application or variable use.\n| Field selector | lower_case | Must be the same as function names.\n| Interface | UpperCase |\n| Instance | lower_case | not first class,\nbut may appear in exp\n| Resources | lower_case |\n|===\n\nNote that there may be more symbol namespaces in the future.\n\nThe general rationale for these suggestions is that things that are different\nshould look different.\n\n.Variables, functions and field selectors\nThe most common symbols should be in lower case and use '_' to separate\nwords are preferred, but not enforced.\n\n.Modules, types and constructors\nIt is useful to visually distinguish these more _meta_ symbols.\nThey're part of the organisation of the program but not really part of the\nprogram.\n\n.Interfaces and instances\nI'm unsure what's best here.\nWe may wish to make them distinct so that instanced and module qualification\ndo not overlap.\n\n.Types and type variables\nType variables must be distinguished from types.\nThis is because free type variables can appear in type expressions without being\nintroduced and we'd like to distinguish free type variables from misspelt\ntype names.\nSo that Plasma can be used in scripts without lower and upper case we use a\nsigil. Type variables are always proceeded by a +'+ (apostrophe) sigil.\n\nA list of values of any type +t+ (but it must be the same type for each\nelement):\n\n----\nList('t)\n----\n\nA list of +t+, that is values whose type is +t+, a defined type.\n\n----\nList(t)\n----\n\n[[environment]]\n== Environment\n\nThe _environment_ is a concept we will consider for Plasma's scoping rules.\nThe environment maps symbols to their underlying items (modules, types,\nfunctions, variables etc). Even though no environment exists at runtime,\nand the compile-time structure is an implementation detail of the compiler\n(+pre.env+), it is useful to think of scoping in these terms, as it explains\nmost scoping behaviours.\n\nSome languages allow overloading of symbols, usually based on a symbol's\ntype and sometimes on it's arity. Plasma does not support any overloading.\n\n=== Scopes\n\nWhen a new name is defined it is added to the current environment.\n\n----\nprint!(x) # x does not exist.\nvar x = \"hello\" # x (a variable) is added to the environment.\nprint!(x) # We may now refer to x.\n----\n\nWhen a nested block starts, it creates a new environment based upon the old\nenvironment.\n\n----\nvar x = \"hello\"\nif (...) {\n print!(x) # Ok\n}\n----\n\nWhen a nested block ends, the original environment is restored.\n\n----\nif (...) {\n var x = \"Hello\"\n print!(x) # Ok\n}\nprint!(x) # Error\n----\n\n=== Shadowing\n\nShadowing refers to a new binding with the same name as an old binding being\npermitted and dominant in an _inner_ or _later_ scope.\nShadowing is not permitted for variables at all. It is permitted for other\nsymbols.\n\nNOTE: TODO: Decide on rules for a symbol of one type overriding a symbol of\nanother type. For example it should probably be an error for a module\nimport to shadow an interface declaration. But it's probably okay for a\nvariable to overload a function, unless that function is defined within\nanother function (a closure).\n\n==== Variables\n\nA variable cannot shadow another variable.\n\n----\nvar x = 3\nvar x = 4 # Error\n\nif (...) {\n var x = 5 # Error\n}\n----\n\nNOTE: We are considering a special syntax to use with variables that allows\nshadowing.\n\n==== Other symbols\n\nSymbols other than variables allow shadowing, for example module imports can\ncreate shadowing of their contents (types, functions etc).\nIncluding when import is used with a wildcard. Therefore we can use a\ndifferent +Set+ implementation in the inner scope:\n\n----\nimport SortedListSet as Set\n...\n# some code\n...\n{\n import RBTreeSet as Set\n ...\n # some code using RBTreeSets\n ...\n}\n...\n# back to SortedListSet\n...\n----\n\n(Yes, module imports may appear within function bodies and so-on.)\n\nHowever, a binding that cannot be observed such as:\n\n----\nimport SortedListSet as Set\nimport RBTreeSet as Set\n----\n\nDoesn't make sense, and the compiler should generate a warning.\n\nTODO: Figure out if context always tells us enough about the role of a\nsymbol that modules do not need to shadow types and constructors. I suspect\nthis is true but I'll have to define the rest of the language first.\n\n=== Namespaces\n\nThe environment maps names to items. Names might be qualified and if so the\nqualifier is required to refer to that name. For example.\n\n----\nimport Set\nmy_set1 = Set.new # Ok\nmy_set2 = new # Undefined symbol\n----\n\nTODO: Probably need to create a new keyword to introduce these, the\nequivalent of +var+.\n\nOr they can be unqualified\n\n----\nimport Set.new\nmy_set1 = Set.new # Undefined symbol Set\nmy_set2 = new # Ok\n----\n\nThe name within the namespace does not need to correspond to the name as\nit was defined.\n\n----\nimport Set.new as new_set\nmy_set = new_set # Ok\n----\n\nThis applies to all symbols except for variables, which can never be\nqualified. There is no syntax that would allow a variable to be defined\nwith a qualifier.\n\n== Modules\n\nEach file is a module, the file name must match the module name (case\ninsensitive, with - and _ characters stripped). By convention CamelCase is\nused.\n\nEach module begins with a module declaration.\n\n----\nModuleDecl := 'module' QualifiedIdent\n----\n\nFor example.\n\n----\nmodule MyModule\n----\n\nModules may be organised into a heirachy by placing dots between identifiers\nto create the heirachy. Imagine a set of modules for networking such as:\n\n----\nNet.HTTP\nNet.HTTP.Extension // Some custom extension \nNet.Common // Common code used internally by the Net libraries\nNet.FTP\nNet.SSH\n----\n\nEach of these will have it's fully qualified name in the module declaration\nat the beginning of its file.\n\nFuture work:\n\n * link:https://github.com/PlasmaLang/plasma/issues/316[Bug 316 - Support\n for libraries]\n * link:https://github.com/PlasmaLang/plasma/issues/352[Bug 352 - Package\n local modules] (To implement modules not available outside a \"package\"\n like the Common module in the example above).\n\n=== Exports\n\nResources, types and functions (all below) can all be exported from a module\nby placing the `export` keyword in front of them:\n\n----\nexport\nresource MyRes from IO\n\nexport\ntype MyMaybe('x) = Nothing\n | Some(x : 'x)\n\nexport\nfunc myFunc() uses IO {\n print!(\"Hello from a foreign module!\\n\")\n}\n----\n\nTypes may additionally be opaque-exported:\n\n----\nexport opaque\ntype Tree('k, 'v) = Empty \n | Node(\n k : 'k,\n v : 'v,\n l : Tree('k, 'v),\n r : Tree('k, 'v)\n )\n----\n\nwhich exports the type name but not how it is constructed. The above can\nexport a tree without exposing the detail that it is a binary tree and\nensuring that all the code for keeping the tree ordered correctly or\nbalanced is in a single module.\n\nAn exported thing may only refer to types and resources that are also\nexported.\nMore precisely. a non-opaque exported thing may only refer, in its\ndeclaration but not its body, to types and resources that are either\nexported.\n\nFor example:\n\n----\nresource A from IO\n\nexport\nresource B from A\n\nexport\nfunc foo() uses A {\n ...\n}\n----\n\n`B` and `foo` cannot be exported because A is not exported.\n\nLikewise:\n\n----\ntype A = ...\n\nexport opauqe\ntype B = ...\n\nexport\ntype C = C(a : A)\n\nexport\ntype D = D(b : B)\n----\n\n`C` cannot be exported because `A` is not exported. `D` may be exported\nbecause `A` ls /opaque exported/.\n\nFuture work:\n\n * link:https://github.com/PlasmaLang/plasma/issues/360[Abstract/opaque\n resources]\n\n== Imports\n\n----\nImportDirective := 'import' QualifiedIdent\n | 'import' QualifiedIdent as ident\n----\n\nModules may be imported with an import declaration.\n\n----\nimport RBTreeMap\nimport RBTreeMap as Map\n----\n\n+import+ imports a module. Lines one and two add a\nmodule name (+RBTreeMap+ or +Map+, respectively) to the current environment.\n\nFor now all references to symbols from other modules\nmust be module qualified.\nThis is either with the module's name (e.g: +RBTreeMap+)\nor with a renaming of the module (e.g: +Map+),\n\nA module cannot be used without an +import+ declaration.\n\n== Types\n\nThe Plasma type system supports:\n\n* Algebraic types\n* parametric polymorphism (aka generics)\n* Abstract types\n* Other features may be considered for a later version\n* Type variables begin with a +`+ sigil,\n* By convention type variables a lower case while type names begin with an\n uppercase letter.\n\nSee also link:types.html[Type system design] which reflects more up-to-date\nideas.\n\nType expressions refer to types.\n\n----\nTypeExpr := TypeName ( '(' TypeExpr ( ',' TypeExpr )* ')' )?\n | 'func' '(' ( TypeExpr ( ',' TypeExpr )* )? ')' Uses* RetTypes?\n | '\\'' TypeVar\n\n# Uses denotes which resources a function may use.\nUses := 'uses' QualifiedIdent\n | 'uses' '(' QualifiedIdentList ')'\n | 'observes' QualifiedIdent\n | 'observes' '(' QualifiedIdentList ')'\n\nRetTypes := '->' TypeExpr\n | '->' '(' TypeExpr ( ',' TypeExpr )* ')'\n\nTypeName := QualifiedIdent\nTypeVar := ident\n----\n\nWe can define new types using type definitions\n\n----\nTypeDefinition := ('export' 'opaque'?)?\n 'type' ident TypeParams? = OrTypeDefn ( '|' OrTypeDefn )*\n\nTypeParams := '(' ( '\\'' Ident )* ')'\n\nOrTypeDefn := ConstructorName\n | ConstructorName '(' TypeField ( , TypeField )+ ')'\n\nTypeField := FieldName ':' TypeExpr\n | TypeExpr # Not supported\n\nConstructorName := ident\nFieldName := ident\n----\n\n+TypeParams+ is a comma separated list of lowercase identifiers.\n\n+TypeField+ will need lookahead, so for now all fields must be named, but\nthe anonymous name (+_+) is supported.\n\nTODO: We use vertical bars to separate or types. Vertical bars mean \"or\"\nand are used in Haskell, but in C commas (for enums) and semicolons (for\nunions) are used. Which is best? Mercury uses semicolons as these mean\n\"or\" in Mercury.\n\nTODO: We use parens around the arguments of constructors, like Mercury, and\nbecause fancy brackets aren't required. However curly braces would be more\nfamiliar to C programmers.\n\n=== Builtin types\n\nHow \"builtin\" these are varies. +Ints+ are completely builtin and handled by\nthe compiler where as a List has some compiler support (for special symbols\n& no imports required to say \"List(t)\") but operations may be via library\ncalls.\n\n* Int\n* Uint\n* Int8, Int16, Int32, Int64\n* Uint8, UInt16, UInt32, UInt64\n* CodePoint (a unicode codepoint)\n* Float (NIY)\n* Array('t)\n* List('t)\n* String (neither a CString or a list of chars).\n* Function types\n\nThese types are implemented in the standard library.\n\n* CString\n* Map('t)\n* Set('t)\n* etc...\n\n=== User types\n\nUser defined types support discriminated unions (here a +Map+ is\neither a +Node+ or +Empty+), and generics (+'k+ and +'v+ are type parameters).\n\n----\ntype Map('k, 'v) = Node(\n m_key : 'k,\n m_value : 'v,\n m_left : Map('k, 'v),\n m_right : Map('k, 'v)\n )\n | Empty\n----\n\nTODO: Syntax will probably change, I don't like +,+ as a separator, I prefer\na terminator, or nothing to match the rest of the language. Curly braces?\n+|+ is also used as a separator here.\n\nTypes may also be defined opaquely, with their details hidden behind module\nabstraction.\n\n[[interfaces]]\n== Interfaces\n\nInterfaces are a lot like OCaml modules. They are not like OO classes and\nonly a little bit like Haskell typeclasses.\n\nInterfaces are used to say that some type and/or code behaves in a particular\nway.\n\nThe +Ord+ interface says that values of type +Ord.t+ are totally ordered\nand provides a generic comparison function for +Ord.t+.\n\n----\ntype CompareResult = LessThan | EqualTo | GreaterThan\n\ninterface Ord {\n type t\n\n func compare(t, t) -> CompareResult\n}\n----\n\n+t+ is not a type parameter but +Ord+ itself may be a parameter to another\ninterface, which is what enables +t+ to represent different types in different\nsituations; +compare+ may also represent different functions in different\nsituations.\n\nWe can create instances of this interface.\n\n----\ninstance ord_int : Ord {\n type t = Int\n\n func compare(a : Int, b : Int) -> CompareResult {\n if (a < b) {\n LessThan\n } else if (a > b) {\n GreaterThan\n } else {\n EqualTo\n }\n }\n}\n----\n\nNote that in this case each member has a definition. This is what makes\nthis an interface instance (plus the different keyword), rather than an\n(abstract) interface. The importance of this distinction is that interfaces\ncannot be used by code directly, instances can.\n\nCode can now use this instance.\n\n----\nr = ord_int.compare(3, 4)\n----\n\nInterfaces can also be used as parameter types for other interfaces.\nHere we define a sorting algorithm interface using an instance (+o+) of the\n+Ord+ interface.\n\n----\ninterface Sort {\n type t\n func sort(List(t)) -> List(t)\n}\n\ninstance merge_sort(o : Ord) : Sort {\n type t = o.t\n func sort(l : List(t)) -> List(t) {\n ...\n }\n}\n----\n\n+merge_sort+ is an instance, each of its members has a definition, but it\ncannot be used without passing an argument (an instance of the +Ord+\ninterface). A list of +Int+s can now be sorted using:\n\n----\nsorted_list = merge_sort(ord_int).sort(unsorted_list)\n----\n\nNOTE: This example is somewhat contrived, I think it'd be more convenient\nfor sort to take a higher order parameter. But the example is easy to\nfollow.\n\n+merge_sort(ord_int)+ is an instance expression, so is +ord_int+ in the\nexample above.\nInstance expressions will also allow developers to name and reuse specific\ninterfaces, for example:\n\n----\ninstance s = merge_sort(ord_int)\nsorted_list = s.sort(unsorted_list)\n----\n\nMore powerful expressions may also be added.\n\nInstances can also be made implicit within a context:\n\n----\nimplicit_instance merge_sort(ord_int)\nsorted_list = sort(unsorted_list)\n----\n\nThis is useful when an instance defines one or more operators, it makes\nusing the interface more convenient. Suitable instances for the basic types\nsuch as Int are implicitly made available in this way.\n\nOnly one implicit instance for the given interface and types may be used at\na time.\n\n== Resources\n\n----\nResourceDefinition := ('export' 'opaque'?)? 'resource' Ident 'from' QualifiedIdent\n----\n\nThis defines a new resource. The resource has the given name and is a\nchild resource of the specified resource. +SuperRes+ is the ultimate\nresource and is already defined, along with it's child resource such as\n+IO+. See 'Handling effects' below.\n\n== Code\n\n=== Functions\n\n----\nFuncDefinition := FuncExport 'func' ident '(' ( Param ( ',' Param )* )? ')'\n Uses* RetTypes? Block\n\nFuncExport := 'export' 'entrypoint'?\n | 'entrypoint' 'export'?\n |\n\nParam := ident ':' TypeExpr\n | '_' : TypeExpr\n | TypeExpr (Only in interfaces)\n\nRetTyes := '->' TypeExpr\n | '->' '(' TypeExpr ( ',' TypeExpr )* ')'\n\nBlock := '{' BlockThing* Return? '}'\n\nBlockThing := Statement\n | Definition\n----\n\nUses is defined above in the type declarations section.\n\nTODO: Probably add support for naming return parameters\n\nTODO: Consider adding optional perens to enclose return parameters.\n\nTODO: More expressions and statements\n\nCode is organised into functions.\n\nA function has the following form.\n\n----\nfunc Name(arg1 : type1, arg2 : type2, ...) -> ret_type1, ret_type2\n Resources?\nBlock\n----\n\nIn the future if the types are omitted from a non-exported function's\nargument list the compiler will attempt to infer them. For now all types\nare required.\n\nTODO: Find a way that return parameters can be named. This will change the\nbehaviour of functions WRT having the value of their last statement.\n\nTODO: What if neither the name or type of a return value is specified?\n\nResources is optional and may either or both \"uses\" or \"observes\" clauses,\nwhich are either the uses or observes keywords followed by a list of one\nor more comma separated resource names.\n\nThe special symbol +_+ can be used as a parameter to ignore any arguments\npassed in that position, the type is still enforced.\n\nNote that function bodies may contain definitions. Allowing functions to be\nnested and in the future other definitions may be scoped within function\nbodies.\n\nIf the definition is preceeded by +export+ then the function is made\navailable to other modules.\n\n=== Statements\n\n----\nStatement := FuncDefinition\n | VarDeclaration\n | Assignment\n | Call\n | MatchStemt\n----\n\n==== Nested functions\n\nPlasma supports nested functions, which may also be closures.\n\n----\nvar greeting = \"Hello \"\nfunc hi(name : String) -> String {\n return greeting ++ name ++ \"\\n\"\n}\n\nprint!(hi(\"Paul\"))\n----\n\nOther than being able to close over other values, the only difference is\nthat these functions do not (yet) support mutual recursion\n(bug https://github.com/PlasmaLang/plasma/issues/177[#177]).\n\nIn the future we also intend to support lambda expressions\n(bug https://github.com/PlasmaLang/plasma/issues/165[#165]) and partial\napplication (bug https://github.com/PlasmaLang/plasma/issues/164[#164]).\n\n==== Variable declaration\n\n----\nVarDeclaration := 'var' Ident\n----\n\nThis syntax declares a variable without giving it a value. It may be given\na value with an assignment later. This is useful if a variable is given a\nvalue within branches of an if statement but it needs to be visible outside\nthat statement.\n\nFor example:\n\n----\nvar variable\n----\n\nDeclares a new uninitislised variable.\n\n==== Assignment\n\n----\nAssignment := Pattern ( ',' Pattern )* '=' TupleExpr\n\nPattern := Number\n | '[' ']'\n | '[' Pattern '|' Pattern ']'\n | 'var' Ident\n | '_'\n | QualifiedIdent ( '(' Pattern ',' ( Pattern ',' )+ ')' )?\n----\n\nThe right-hand-side (RHS) of an assignment is a series of expressions\nseparated by commas (a +TupleExpr+).\nMore than one expression is used when there is more than one pattern on the\nleft-hand-side.\nSometimes a single expression is used when that expression's arity matches\nthe number of patterns (eg: a call that returns multiple values).\n\nPlasma is a single assignment language.\nVariables have two possible states, uninitialised and initialised (aka\nassigned).\nEach variable can only be initialised once along any execution path, and\nmust be initialised on each execution path that falls-through (see\n<>).\n\nIn an assignment a pattern must be irrefutable (always matches),\nthis means that only the last three syntactic forms of +Pattern+ make sense\nin an assignment.\nThe first may also be used if we allow refutable patterns in some contexts\nin the future.\n\nIdentifiers in the pattern must be, and are checked in this order:\n * Data constructors if followed by `(`.\n * New variables appearing fresh in the pattern (have the +var+ keyword).\n * Uninitialised variables declared ahead of the pattern.\n * Data constructors (constants).\n\nThis is sound because (TODO):\n * The compiler will warn if a programmer shadows a constructor with a new\n variable.\n * The compiler will warn (lint level) if the programmer didn't need to\n separate variable declaration from initialisation.\n\nExamples:\n\n----\nvariable = expr\n----\n\nInitialise a previously declared variable.\n\n----\nvar variable = expr\n----\n\nDeclares and initialises a new variable (this is preferred where possible).\n\n----\nvar var1, var var2 = expr1, expr2\n----\n\nBoth variables are declared, `var1` is initialised to the value of `expr1`\nand `var2` to `expr2`.\n\n----\nvar var1, var var2 = expr\n----\n\nThe expression returns two values, `var1` takes the first value and `var2`\nthe second.\n\n----\nvar div, _ = div_and_quot(7, 5)\n----\n\nThe wildcard symbol '_' matches everything and is used to ignore the\nsome values. The function call returns two values but only the first is\ncaptured.\n\n----\nPoint(var x, var y) = expr\n----\n\nThe expression returns the data constructor Point (irrefutably). Point is\ndeconstructed and `x` and `y` are new variables that take the values from\nthe Point.\n\nYou may also use the wildcard `_` and other constructors (provided they're\nirrefutable within a pattern.\n\n----\nvar x\nPoint(x, _) = expr\n----\n\nThe first statement declares the variable `x` and the second statement binds\nit.\n\n----\nPoint(x, _) = expr\n----\n\n`x` is not a variable in this context and therefore it must be a data\nconstructor, and must be matched irrefutably.\n\n----\n_ = close!(file)\n----\n\nIgnores the result of a function call that affects a resource.\n\n==== Function call\n\n----\nCall := ExprPart1 '!'? '(' Expr ( , Expr )* ')'\n----\n\nFunction calls often return values, however functions that do not return\nanything can be called as a statement. Such a function only makes sense if\neffects a resource, and therefore will have a '!'. However the grammar and\nsemantics allow functions that don't have an affect (the compiler will\nalmost certainly optimize these away).\n\n----\nfunction_name!(arg1, arg2)\n----\n\nCalls may also be expressions (see below), as an expression a call might\nstill use or observe some resource. However only one call per statement may\nobserve the same or a related resource, this ensures that effects happen in\na clear order.\n\n==== Return\n\n----\nReturn := 'return' TupleExpr\n | 'return'\n----\n\nFor example:\n\n----\n# Return one thing\nreturn expr\n\n# Return two things\nreturn expr1, expr2\n\n# Return nothing\nreturn\n----\n\nA function that returns a one or more values must always end in a return\nstatement, or a branching statement that (indirectly) ends in a return\nstatement on each branch.\n\nTODO: This will need to be relaxed for code that aborts.\n\nTODO: Named returns.\n\nFunctions that return nothing may optional use a return statement, this can\nbe used to implement early return.\n\nFunctions and blocks do not have values.\nThis is deliberate to keep functions and expressions _semantically_\nseparate.\nThis means that the last statement of a block does not have any special\nsignificance as it does in some other languages.\n\n==== Pattern matching\n\n----\nMatchStmt := 'match' Expr '{' Case+ '}'\n\nCase := Pattern '->' Block\n----\n\nPattern matching is a statement (as well as an expression).\nCases are tried in the order they are written, the compiler should provide a\nwarning if a case will never be executed, or a value is not covered by any\ncases.\n\n----\nvar beer\nmatch (n) {\n 0 -> {\n beer = \"There's no beer!\"\n }\n 1 -> {\n beer = \"There's only one beer\"\n }\n var m -> {\n beer = \"There are \" ++ show(m) ++ \" bottles of beer\"\n }\n}\nprint!(beer)\n----\n\nIf a variable declared outside the match is assigned by one of the cases\n(like +beer+) then it must be assigned by every case (see\n<>).\n\nCurrently either all cases must have a return statement or none of them.\nTODO Matches where some return and others do not will be added in the future.\n\nNote that a pattern match can bind a variable declared in the outer scope:\n\n----\nvar x\nmatch (...) {\n ...\n x -> { ... }\n}\n\n// x is now set.\n----\n\n==== If-then-else\n\n----\nITEStmt := 'if' Expr Block 'else' ElsePart\nElsePart := ITEStmt\n | Block\n----\n\n----\nif (expr) {\n statements\n} else if (expr) {\n statements\n} else {\n statements\n}\n----\n\nNote: the parens around the condition are optional.\n\nThere may be zero or more else if parts.\n\nPlasma's single-assignment rules imply that if the \"then\" part of an\nif-then-else binds a non-local variable, then there must be an else part\nthat also binds the variable (or does not fall-through). Else branches\naren't required if the then branch does not fall-through or does not bind\nanything (it may have an effect).\n\n[[loops]]\n==== Loops\n\nNOTE: Not implemented yet.\n\nNOTE: I'm seeking feedback on this section in particular.\n\n----\n# Loop over both structures in a pairwise way.\nfor [var x <- xs, var y <- ys] {\n # foo0 and foo form an accumulator starting at 0. The value of foo\n # becomes the value of foo0 in the next iteration.\n accumulator foo0 foo initial 0\n\n # The loop body.\n var z = f(x, y)\n foo = foo0 + bar(x)\n\n # This loop has three outputs. \"list\" and \"sum\" are names of\n # reductions. Reductions are instances of the reduction\n # interfaces. They \"reduce\" the values produced by each iteration\n # into a single value.\n output zs = list of z\n output sum = sum of x\n # foo is not visible outside the loop, an output is required to\n # expose it. value is a keyword, it is handled specially and\n # simply takes the last value encountered.\n output foo_final = value of foo\n}\n----\n\nNOTE: the accumulator syntax will probably change after the introduction of\nsome kind of state variable notation.\n\nTODO: Introduce a more concise syntax for one-liners and expressions, like\nlist comprehensions (see 'Generators' below).\n\nThe loop will iterate over corresponding items from multiple inputs. When\nthey're not of equal length the loop will stop after the shortest one is\nexhausted. This decision allows them to be used with a mix of finite and\ninfinite sequences.\n\nLooping over the Cartesian combination of all items should also be supported\n(syntax not yet defined, maybe use +&+). This is equivalent to using nested\nloops in many other languages.\n\nValid input structures are: lists, arrays and sequences. Sequences are\ncoroutines and therefore can be used to iterate over the keys and values of\na dictionary, or generate a list of numbers.\n\nTODO: Possibly allow this to work on keys and values in dictionaries. If\nthe keys are unmodified during the loop then the output dictionary can be\nrebuilt more easily, its structure doesn't need to change. Lua has the\nability to require keys to be sorted, or to drop this requirement.\n\nThe output declarations include a reduction. This is how the loop should\nbuild the result.\n\nTODO: Reduction isn't a good word for it, since the output type can be\neither a scalar or a vector.\n\nThe reduction can be completely different from the type of any of the\ninputs. This builds an array from a list (or other ADT). This uses the\n+array+ reduction.\n\n----\nfor [var x <- xs] {\n var y = f(x)\n output ys = array of y\n}\n----\n\nMany reductions will be possible: +array+, +list+, +sequence+, +min+, +max+,\n+sum+, +product+, +concat_list+. Developers will be able to create their\nown as these are interfaces.\n\nLoops are implemented in terms of coroutines. Coroutines return the values\nfor the inputs and the loop body and coroutines handle building the value of\nthe outputs (list and sum are coroutines above). Coroutines offer the most\nflexibility as some of their state is kept on the stack.\n\nSimpler implementations should be used as an optimisation when it is\npossible. In these cases some loops may be optimised to calls to map or\nfoldl, or even simpler inline code.\n\nAuto-parallelisation (a future goal) will work better with reductions that\nare known to be either:\n\n- Order independent\n- Associative / commutative, but whose input type is the same as the output\n- Mergable, with a known identity value.\n\nAccumulators are implemented more directly (not coroutines). However they\nrequire the iterations to be processed in a specific order and may inhibit\nparallelisation. A dependency analysis on the body and separating out the\ncode for each accumulator may mitigate this, especially if it can be\ncombined with the same analyses as reductions above.\n\nTODO: Consider allowing for loops as expressions, maybe a simplified case.\nThis will be similar to a list comprehension.\n\nNote that Plasma's for loops may be similar to some language's query syntax\nlike LINQ. TODO: Look there for other ideas.\n\nTODO: skip statements. A `skip` statement is like the opposite of the\n`where` part in some language's list comprehensions, but perhaps more\nflexible like C's `continue` statement. Technically if we can support this\nthen we can also support `break`, but I don't like it because it doesn't\nencourage a preferred style. Furthermore if we go this far it's a simple\nstep to use any generator (below) with `break` to create something as\ngeneral as a while loop. It may even look very similar to a while loop\nwith the right sugar.\n\nTODO: Consider also the \"scan\" or \"search\" loop pattern, where once we find\nwhat we're looking for we break, maybe potentially removing the item from a\ncollection?\n\nIs filter part of the scan pattern or the fold pattern?\n\n=== Expressions\n\nExpressions are broken into two parts. This allows us to parse call\nexpressions properly, with the correct precedence and without a left\nrecursive grammar. Binary operators are described as a left recursive\ngrammar, but are not implemented this way, their precedence rules are\ndocumented below.\n\n----\nTupleExpr := Expr ( ',' Expr )*\n\nExpr := 'match' Expr '{' (Pattern '->' TupleExpr)+ '}'\n | 'if' Expr 'then' TupleExpr 'else' TupleExpr\n | Expr BinOp Expr\n | UOp Expr\n | ExprPart1 '!'? '(' Expr ( , Expr )* ')' % A call or\n % construction\n | ExprPart1 '[' '-'? Expr ( '..' '-'? Expr )? ']' % array access\n | ExprPart1\n\nExprPart1 := '(' Expr ')'\n | '[' ListExpr ']'\n | '[:' TupleExpr? ':]' # An array\n | QualifiedIdent # A value\n | Const # A constant value\n\nBinOp := '+'\n | '-'\n | '*'\n | '/'\n | '%'\n | '++'\n | '>'\n | '<'\n | '>='\n | '<='\n | '=='\n | '!='\n | 'and'\n | 'or'\n\nUOp := '-' # Minus\n | 'not' # Logical negation\n----\n\nUOp operators have higher precedence than BinOp, BinOp precidence is as\nfollows, group 1: * / %, group 2: + - group 3: < > <= >= == !=,\ngroup: 4-7: and or ++ , See <>. \n\nLists have the following syntax (within square brackets)\n\n----\nListExpr := e\n | Expr ( ',' Expr )* ( '|' Expr )?\n----\n\nExamples of lists are:\n\n----\n# The empty list\n[]\n\n# A cons cell\n[ head | tail ]\n\n# A list 1, 2, and 3 are \"consed\" onto the empty list.\n[ 1, 2, 3 ]\n\n# Consing multiple items at once onto a list.\n[ 1, 2, 3 | list ]\n----\n\nArrays elements may be access by _subscripting_ the array. Eg\n+a[3]+ will retrieve the 3rd element (1-based). A dash before the subscript\nexpression will count backwards from the end of the array, +a[-2]+ is the\nsecond last element. This syntax currently clashes with unary minus and so\nis currently unimplemented. Array slices will use the +..+ token and are\nalso unimplemented.\n\nTODO: Arrays may also be typed and subscripted to work with a particular\nenum (See the Ada programming language). This should include a different\nrange (maybe dynamic) than the full enum's range.\n\nAny control-flow statement is also an expression.\n\n----\nx = if (...) then expr else expr \n----\n\nOr\n\n----\nx = case (expr) {\n Leaf(var k, var v) = ...\n Node(var l, var k, var v, var r) = ...\n}\n----\n\n=== Streams/Generators\n\nTODO: This whole section\n\nPlasma will support coroutines that can be used for generators. It may be\nuseful for list/array comprehensions if we choose to add those.\nBut also to support loops above. Some things to support with generators\nare:\n\n * Generate a sequence from the items of an enum type (see Ada).\n * Generate a sequence from integers / floats with some step, (a special\n case of enums)\n * Generate a shortened sequence, 7..21 or Monday..Friday\n * Use guards to select which items are included.\n * Create generators from for loops, enabling the use of an accumulator.\n This will make them almost like list comprehensions except as statements.\n * Consider syntax sugar when the generator is a function:\n\n----\nvar array = [\\x -> case x of\n Sat..Sun -> 2\n _ -> 8\n for x <- enum(Days)]\n\n// could be:\nvar array = [Sat..Sun -> 2\n others -> 8]\n----\n\nThis hides both the lambda expression and the pattern match. Note that\nlambda or generator syntax is not specified yet so this may be different in\nreality, or not implemented at all.\n\n== Pragmas\n\n----\nPragma := 'pragma' Ident '(' PragmaArgs? ')'\n\nPragmaArgs := PragmaArg (',' PragmaArg)*\n\nPragmaArg = String \n----\n\nPragmas provide a way for the programmer to communicate something \"out of\nbound\" to the compiler/other tools. This is usually not something that's\npart of the program's meaning, but how it should be interpreted. For\nexample what library to include or how to compile something.\nThey take the form above with the identifier being the name of the pragma\nwhich the compiler or other tools will use as a first step to interpret the\npragma.\n\nPragmas will generally have the form:\n\n----\npragma Verb(Noun0, Noun1 ... NounN)\n----\n\nThere may be any number of nouns including zero. A Plasma implementation\nwill define what verbs are meaningful and which nouns (if any) are\nmeaningful for that verb. A Plasma implementation *should* issue a warning\nbut *must not* issue an error (except for a warnings-as-errors mode) for a\npragma it doesn't understand.\n\nThis Plasma implementation understand the following pragma:\n\n----\npragma foreign_include(String)\n----\n\nWhich says that the foreign code elsewhere in this file requires the foreign\n(C language) header file named by the string literal.\n\n== Ideas\n\nThese are just ideas at this stage, they are probably bad ideas.\n\nIf a multi-return expression is used as a sub-expression in another context\nthen that expression is in-turn duplicated.\n\n----\nvar x, y = multi_value_expr + 3\n----\n\nis\n\n----\nvar x0, y0 = multi_value_expr\nvar x = x0 + 3\nvar y = y0 + 3\n----\n\nTherefore calls involved in these expressions must not \"use resources\".\n\nAnother idea to consider is that a multiple return expression in the context\nof function application applies as many arguments as values it returns. We\nprobably won't do this.\n\n----\n... = bar(foo(), z);\n----\n\nIs the same as\n\n----\nvar x, y = foo();\n... = bar(x, y, z);\n----\n\n[[resources]]\n== Handling effects (IO, destructive update)\n\nPlasma is a pure language, we need a way to handle effects like IO and\ndestructive update. This is called resources. A function call that uses a\nresource (such as +print()+), may only be called from functions that declare\nthat they use a resource. This means that a callee cannot use a resource\nthat a caller doesn't expect (resource usage is transitive) and anyone\nlooking at a functions' signature can tell that it might use a resource.\n\nA resource usage declaration looks like:\n\n----\nfunc main() -> Int uses IO\n----\n\nHere +main()+ declares that it uses (technically _may use_) the +IO+\nresource. Resources can be either _used_ or _observed_; and a function may\nuse or observe any number of resources (decided statically). An observed\nresource may be read but is never updated, a used resource may be read or\nupdated. This distinction allows two observations of a resource to commute\n(code may be re-arranged during optimisation), but two uses of a resource\nmay not commute.\n\nDevelopers may declare new resources, the standard library will provide some\nresources including the +IO+ resource. Examples of +IO+ 's children might be\n+Filesystem+ and +Time+, +Filesystem+ might have children for open files\n(WIP), although none of these have been decided / implemented.\n\nA call is valid if:\n\n|===\n| | Callee is Pure | Callee may Observe | Callee may Use\n| Caller is Pure | Y | N | N\n| Caller may Observe | Y | Y | N\n| Caller may Use | Y | Y | Y\n|===\n\nYou'll find that this is very intuitive.\nIt's shown in a table for completeness.\n\n=== Resource hierarchy\n\nResources form a hierarchy (not yet defined). For a call to be valid either\nthe resource, or its parent must be available in the caller. For example if\n+mkdir()+ uses the +Filesystem+ resource, which is a child of +IO+ then any\ncaller that +uses IO+ can call +mkdir()+.\n\n=== Temporary resources (NIY)\n\nSome resources can be creating and destroyed, and rather than being a part\nof their parent always (+Filesystem+ is always a part of +IO+) they are\nsubsumed by their parent instead. For example an array uses some memory as\nits resource, that memory is allocated and freed when the array is\ninitialised and then goes out of scope (it is unique). But if that\nthe memory resource is created and destroyed within the same function, it's\ncaller does not need the uses declaration, memory and possibly some other\nresources are special cases.\n\n=== Resources in statements\n\nEvery call that uses a resource must have the +!+ suffix. For example:\n\n----\n print!(\"Hello world\\n\")\n----\n\nThis makes it clear to anyone reading the code to *beware* something\n_happens_, _changes_ or might be _observed_ to have happened or have\nchanged. This is also the entire reason to have it in the language, it\nserves no other function, but the compiler will make sure that it is\npresent on every call that either uses or observes something.\n\nMultiple calls with +!+ may be used in the same statement, provided that\ntheir resources do not overlap, or they are all observing the resource and\nnot modifying it. (Note that we are debating) this at the moment).\n\n=== Commutativity of resources\n\nOptimisation may cause code to be executed in a different order than\nwritten. The following reorderings of two related (ancestor/descendant)\nresources are legal.\n\n|===\n| | None | Observe | Use\n| None | Y | Y | Y\n| Observe | Y | Y | N\n| Use | Y | N | N\n|===\n\nNon-related resources may be reordered freely.\n\n=== Higher order code\n\nThis aspect of Plasma is under consideration and may change in the future.\nThe concerns are:\n\n * Higher order functions need to handle resources, otherwise their\n usefulness is reduced.\n * Resource usage from such code needs to be safe (WRT order of operations).\n * We want to encourage polymorphism here, otherwise people will write\n higher-order abstractions that can't be used with resources.\n * We'd prefer to make code concise that isn't intended to be used with\n resources, but ought to be resource-capable anyway.\n\n==== Current behaviour (WIP)\n\nHigher order values may have +uses+/+observes+ declarations (added to their\ntype) values without such declarations are pure. All higher order calls\nhave the usual +!+ sigil and the statement rules apply.\n\nMap over list looks like:\n\n----\nfunc map(f : 'a -> 'b uses r, l : List('a)) -> List('b) uses r {\n switch (l) {\n case [] -> {\n return []\n }\n case [var x0 | var xs0] -> {\n var x = f!(x0)\n var xs = map!(f, xs0)\n return [x | xs]\n }\n }\n}\n----\n\nNote that the calls to +f+ and +map+ must be in separate statements.\n\nThis has the disadvantage that it is not as concise, and that people who aren't\nplanning to use resources, won't write resource-capable code, if that code is\nin a library it may be annoying to modify if it needs to be used with a\nresource later.\n\nNOTE: This is almost implemented, polymorphic resources are not yet implemented.\n\n==== Other proposals\n\nThere are several other ideas and their combinations that may help.\n\n * All higher order code implicitly uses resources, a function like map\n therefore also uses that resource since it contains such calls. When a\n higher order value doesn't mention resources it is implied to use some\n polymorphic resource set. To say that no resources are involved and\n ordering is not important the +pure+ keyword may be used in place of a\n +uses+ or +observes+ clause. Type inference may help make this easier.\n * Require all higher-order code to handle resources, users may feel that the\n compiler is being overly-pedantic.\n * Higher order calls are exempt from the one-resource-per-statement rule.\n Making the code more concise (it still includes a !).\n ** Either expressions have a well-ordered declarative semantics or\n ** resources must be declared as 'don't-care' ordering so they can be placed\n in the same statements.\n\n=== Linking to and storing as data (NIY)\n\nLinking a resource with a _real_ piece of data, such as a file descriptor,\nis highly desirable. Likewise putting such data inside a structure to be\nused later, such as a pool of warmed-up database connections, will be\nnecessary.\n\nThere are a couple of ideas. We could add information to the types to say\nthat they are resources and what their parent resource type is. So that the\nvariable can stand-in for the resource.\n\n----\ntype Fd =\n resource from Filesystem\n\nfunc write(Fd, ...) uses Fd\n----\n\n== Builtins\n\nThese builtin operations are always available, they don't need to be\nimported from a module.\n\n// This documentation should be kept in-sync with tests/builtin/\n// and tests/language/operators.p\n\n`type Maybe('v)`:: A maybe type, defined as:\n----\ntype Maybe('v) = Some('v)\n | None\n----\n\n=== Integers\n\n`type Int`:: A signed 2's compliment integer, its width is at least 32 bits and\nimplementation defined.\n\n`Int + Int -> Int`:: Addition\n (also `func Builtin.int_add(a : Int, b : Int) -> Int`)\n\n`Int - Int -> Int`:: Subtraction\n (also `func Builtin.int_sub(a : Int, b : Int) -> Int`)\n\n`Int * Int -> Int`:: Multiplication\n (also `func Builtin.int_mul(a : Int, b : Int) -> Int`)\n\n`Int / Int -> Int`:: Division\n (also `func Builtin.int_div(a : Int, b : Int) -> Int`)\n\n`Int % Int -> Int`:: Modulo/Remainder\n (link:https://github.com/PlasmaLang/plasma/issues/378[#378, which one?])\n (also `func Builtin.int_mod(a : Int, b : Int) -> Int`)\n\n`- Int -> Int`:: Unary minus (prefix operator, takes only one argument).\n (also `func Builtin.int_minus(a : Int) -> Int`)\n\n`func Builtin.int_lshift(a : Int, b : Int) -> Int`::\n Left shift `a` by `b` bits.\n\n`func Builtin.int_rshift(a : Int, b : Int) -> Int`::\n Right shift `a` by `b` bits.\n\n`func Builtin.int_and(a : Int, b : Int) -> Int`::\n Bitwise and.\n\n`func Builtin.int_or(a : Int, b : Int) -> Int`::\n Bitwise or.\n\n`func Builtin.int_xor(a : Int, b : Int) -> Int`::\n Bitwise exclusive-or.\n\n`func Builtin.int_comp(Int) -> Int`::\n One's compliment (flip all the bits).\n\n`func int_to_string(Int) -> String`::\n Return a string representation of the number. No nice formatting is\n attempted.\n\nFuture work:\n\n * TODO: Use interfaces to provide many of these operations to a group of\n types. Eg many integer operations will apply to all numbers. Same with\n the relational operators below.\n * TODO: Once there is an Int module move the builtin Int functions to it.\n * TODO: The bitwise functions should be for sized integers only.\n\n=== Bools\n\n`type Bool`::\n Is defined as:\n----\ntype Bool = False\n | True\n----\n\n`Int > Int -> Bool`:: Greater than\n (also `func Builtin.int_gt(a : Int, b : Int) -> Int`)\n\n`Int < Int -> Bool`:: Lesser than\n (also `func Builtin.int_lt(a : Int, b : Int) -> Int`)\n\n`Int >= Int -> Bool`:: Greater than or equal to\n (also `func Builtin.int_gteq(a : Int, b : Int) -> Int`)\n\n`Int <= Int -> Bool`:: Less than or equal to\n (also `func Builtin.int_lteq(a : Int, b : Int) -> Int`)\n\n`Int == Int -> Bool`:: Equal\n (also `func Builtin.int_eq(a : Int, b : Int) -> Int`)\n\n`Int != Int -> Bool`:: Not-equal\n (also `func Builtin.int_neq(a : Int, b : Int) -> Int`)\n\n`Bool and Bool -> Bool`:: Logical add\n (also `func Builtin.bool_and(a : Bool, b : Bool) -> Bool`)\n\n`Bool or Bool -> Bool`:: Logical or\n (also `func Builtin.bool_or(a : Bool, b : Bool) -> Bool`)\n\n`not Bool -> Bool`:: Unary not (prefix operator, takes only one argument)\n (also `func Builtin.bool_not(a : Bool) -> Bool`)\n\n`func bool_to_string(Bool) -> String`::\n Return one of the strings \"True\" or \"False\".\n\n=== Strings\n\n`type String`::\n A character string.\n\n`type CodePoint`::\n A Unicode Codepoint (see https://unicode.org/glossary/#code_point).\n\n`type CodepointCategory`::\n The general category of a Unicode codepoint\n (see https://unicode.org/glossary/#general_category).\n Is defined as:\n----\ntype CodepointCategory = Whitespace\n | Other\n----\n\n`type StringPos`::\n A position within a string, a `StringPos` always points to the edge\n between characters, or before the first character or after the last. This\n makes substring operations clearer.\n\n`String ++ String -> String`:: String concatenation\n (also `func Builtin.string_concat(a : String, b : String) -> String`).\n\n`func codepoint_category(CodePoint) -> CodepointCategory`::\n Return the class of a character.\n\n`func codepoint_to_string(CodePoint) -> String`::\n Return a string containing only this codepoint.\n\n`func codepoint_to_number(CodePoint) -> Int`::\n Return the codepoint number for this codepoint.\n\n`func Builtin.int_to_codepoint(Int) -> CodePoint`::\n Make a codepoint from this integer.\n\n`func string_begin(String) -> StringPos`::\n Return a `StringPos` of before the beginning of the string.\n\n`func string_end(String) -> StringPos`::\n Return a `StringPos` of after the end of the string.\n\n`func string_substring(StringPos, StringPos) -> String`::\n Return the string between the two `StringPos` parameters. The two\n parameters must have been created from the same string (runtime checked).\n\n`func string_equals(String, String) -> Bool`::\n Return `True` if the strings are equal.\n\n`func strpos_forward(StringPos) -> StringPos`::\n Return a `StringPos` moved one character forward.\n The `StringPos` must not be at the end of the string (Runtime check).\n\n`func strpos_backward(StringPos) -> StringPos`::\n Return a `StringPos` moved one character backward.\n The `StringPos` must not be at the beginning of the string (Runtime\n check).\n\n`func strpos_next(StringPos) -> Maybe(CodePoint)`::\n Return the next char in the string after `StringPos`. \n If `StringPos` is at the end of the string then `None` is returned.\n\n`func strpos_prev(StringPos) -> Maybe(CodePoint)`::\n Return the previous char in the string before `StringPos`. \n If `StringPos` is at the beginning of the string then `None` is returned.\n\n=== Lists\n\n----\ntype List('t) = ['t | List('t)]\n | []\n----\n\nThe list data type. This is recursively defined to either be a single\nelement (the head) appended on to another list (the tail); or the empty\nlist. The fields of the concatentation constructor (head and tail) have\nnames internal to the compiler, TODO: maybe expose them in a list module if\nfields are permitted to be used as functions in the future.\n\n'[]':: The empty list.\n (also `func Builtin.list_nil() -> List('t)`).\n\n'[x | xs]':: 'x' appended to the front of 'xs'.\n (also `func BUiltin.list_cons('t, List('t)) -> List('t)`).\n\n=== Misc\n\n`resource IO`::\n The uber-resource, it covers all potential effects.\n\n`resource Time from IO`::\n A resource to query the current time with `gettimeofday`.\n\n`resource Environment from IO`::\n A resource to set the environment with `setenv`.\n\n`type IOResult('t)`::\n A result type for many IO operations that may return end-of-file.\n\n type IOResult('t) = Ok('t)\n | EOF\n\n`func print(String) uses IO`::\n Write the string to standard out.\n\n`func readline() uses IO -> IOResult(String)`::\n Read a line from standard in, the newline character is not returned.\n Aborts the program (TODO) on error.\n\n`func Builtin.set_parameter(String, Int) uses IO -> Bool`::\n Set a parameter for the runtime system. There are currently no settable\n parameters so this always returns false.\n\n`func Builtin.get_parameter(String) observes IO -> Bool, Int`::\n Get a parameter, if the parameter exists returns `True, value`, otherwise\n returns `False, 0`. The parameters are:\n `heap_usage`::: The used memory in the heap.\n `heap_collections`::: The number of garbage collections that have occurred\n so far.\n\n`func setenv(String, String) uses Environment -> Bool`::\n Calls `setenv` on POSIX.\n\n`func Builtin.gettimeofday() observes Time -> Bool, Int, Int`::\n Calls `gettimeofday` and returns `True, secs, usecs` on success.\n\n`func Builtin.die(String)`::\n Abort the program with the given message.\n\nA lot of these (eg `die`, `setenv`) exist for testing and will likely change\nor be part of a different module in the future.\n\n[[precedence]]\n=== Operator precedence\n\n.Operator precedence\n[options=\"header\"]\n|==========================\n|Operator 2+| Level \n| `*` | 1 | Associates most tightly\n| `\\` | 1 | Associates most tightly\n| `%` | 1 | Associates most tightly\n| `+` | 2 |\n| `-` | 2 |\n| `<` | 3 |\n| `>` | 3 |\n| `<=` | 3 |\n| `>=` | 3 |\n| `==` | 3 |\n| `!=` | 3 |\n| `and` | 4 |\n| `or` | 5 |\n| `++` | 6 | Associates least tightly\n|==========================\n\nOperators within the same level bind left-to-right, For example:\n\n`1 * 2 / 3` is `(1 * 2) / 3`\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/pz_machine.txt", "content": "Plasma Abstract Machine\n=======================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: October 2018\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nThis document describes the behaviour of the Plasma Abstract Machine (PZ\nMachine). The PZ file format is described in link:pz_format.html[PZ\nBytecode Format]. Implementations of the PZ abstract machine are\nshall be discussed elsewhere (TODO)\n\nIn this document we use the textual version of the .pz files for\nillustrative purposes. However the textual format is never used as an\ninterchange format and rarely used as a language so it does not need or have\na specification.\n\n== Basic data types\n\nThe abstract machine supports words of varying sizes, with the symbols\nrepresenting them.\n\n- 8bit (+w8+)\n- 16bit (+w16+)\n- 32bit (+w32+)\n- 64bit (+w64+)\n- fast word width (+w+)\n- a word width the same width as a pointer (+wptr+)\n- a pointer (+ptr+)\n\nA fast word width is a width that should be the fasted word width for\nintegers on the platform. This may take into account register size, memory\nusage and maybe implementation convenience.\n\nA word with the same width as a pointer and a pointer differ only in whether\nthe garbage collector may trace them. Which is significant in some contexts\n(like structures) but not in others (like instruction parameter widths).\n\n.TODO: Polymorphism\nNOTE: Handle polymorphism for +wptr+/+ptr+. We'll probably remove wptr and\nhandle the pointer vs non-pointer distinction another way.\n\nSome instructions only make sense with either signed or unsigned data, this\nis up to individual instructions, the PZ format and abstract machine don't\ncare. This way \"move a 32bit word\" makes sense regardless of whether the\nword is signed, unsigned, or something else (float, bitfield etc).\n\nThe PZ machine also supports structures and arrays, more on those later.\n\n== Registers\n\nThe PZ Machine is a stack based machine, it has two registers:\n\n* the instruction pointer (aka program counter) (+IP+) and\n* the environment pointer (+ENV+)\n\nthe instruction pointer \"points to\" the next instruction to execute.\nWhile the environment pointer points to the current environment which is\nused by closures to refer to their environment.\n\n== Stacks\n\nThe basic abstract machine is a stack machine with two stacks. A return\nstack and an expression stack. The return stack is used to handle procedure\ncall and return including saved closure environments. Very little control\nof the return stack is available. Both basic instructions and procedures\nare a transformation of the top of the expression stack.\n\n== Notation\n\nA procedure or instruction's signature may look like:\n\n add (w w - w)\n\nThis describes the instruction + as taking two words from the top of stack\nand replacing them with a word. Calling conventions for procedures work the\nsame way. The expression stack is used for argument passing and temporary\nstorage.\n\n fibs (w - w)\n\nFrom a callee's perspective, there is little difference between an\ninstruction and a call.\n\nIf an instruction is available for all word sizes it may be written as:\n\n add (* * - *)\n\nThis is a convention only, there is no support for polymorphism. When using\nthe textual format for PZ, you may disambiguate which instruction you need\nwith a suffix.\n\neg:\n\n add:8\n add:16\n add:32\n add:64\n add:w (fast word width)\n add (no suffix also means fast word width)\n add:ptr (pointer word width)\n\nThis works similarly for literal data. This is a byte containing the number\n23.\n\n 23:8\n\nThis is only available for instructions, not calls.\n\nAlso in our notation we indicate immediate data with CamelCase, and in the\ncase of calls and literal data, the instruction name is not provided. The\ninstruction to use is available via context.\n\n== High level bytecode items\n\nEach item in a bytecode file belongs in one of four types and is referred\nto by a 32bit ID. Each item type has its own ID-space. In other words data\nitem 5 and procedure 5 are separate. Names are used in .pzt files but are\ndiscarded when these are compiled to .pz files. The exceptions are imported\nitems, exported items (TODO), and in the future some names and other\ninformation may be stored for debugging.\n\n=== Imports\n\nEach import is a fully qualified reference to a closure in another module.\nThe list of imports is provided so that .pz files can then refer to each\nimport by an Import ID. The import section of the .pz file maps these IDs\nto names for looking up in other module's symbol tables.\n\n=== Structs\n\nA struct is a record type, and has a lot in common with a C struct. Each\nstruct has a fixed number of fields and each field has a width (as above).\nStructs allow the bytecode interpreter to make its own data layout\ndecisions. Which it may do differently on different platforms.\n\n.Example usage of this information\nTIP: When a program is loaded and the loader reads a struct type. For that\nstruct type it computes offsets for each of the fields, computes the total\nsize.\n\n=== Data\n\nData items come in three types:\n\n* Basic data: a single data item of a specific width.\n* Array data: a number of data items of the same width, usually packed\n together.\n* Structure data: a structure of data, the data item provides the struct ID\n and the value of each field. Structure fields may contain:\n** Basic data (like above)\n** A reference to another data structure\n** A reference to an imported closure\n** (more to come)\n\n=== Procedures\n\nProcedures contain executable code. A procedure's signature is a \"stack\ntransformation\" it represents the top of stack values before and after a\ncall to this procedure. This is explained above.\n\nProcedures are made up of blocks which are used for control flow. The first\nblock in each procedure is executed when the procedure is called. Within\neach procedure blocks are numbered sequentially starting at 0. Jump\ninstructions refer to their destination by block ID.\n\nNote that execution can never \"fall through\" a block, the last instruction\nin every block must be an unconditional control flow instruction.\n\n=== Closures\n\nClosures can be created by code by bundling a procedure reference with an\nenvironment. The environment is a heap allocated struct. See\n+make_closure+ below.\n\nWhen calling a closure the environment is placed into the +ENV+ register and\nthe previous one is pushed onto the stack to be restored after the procedure\ncall.\n\nClosures are also created with the closure declaration, the procedure and\ndata ids are specified.\n\n=== Options\n\nThe PZ format also contains options. Only one option of each type is\nallowed, and the only type (now) is the entrypoint. The entrypoint option\nspecifies the ID of the closure that should be executed to run the module.\n\n== Instructions\n\nEach instruction is made from an opcode, between zero and two operand widths\nand optionally an immediate value.\n\n=== Zero extend, Sign extend and Truncate\n\n ze (* - *)\n se (* - *)\n trunc (* - *)\n\nZero extends, sign extends or truncates the value on the top of the stack.\nBy truncate we mean discard the most significant bytes. While most\ninstructions work on a single operand width, these instructions use two\noperand widths. For example.\n\n ze (w16 - w32)\n\nNote that it is not necessary (or advised) to use these instructions to\nconvert to and from pointer data, for example to manipulate tagged pointers.\n\n=== Arithmetic\n\n add (* * - *)\n sub (* * - *)\n mul (* * - *)\n div (* * - *)\n mod (* * - *)\n\nInteger addition, subtraction, multiplication, division and modulus.\n\n lshift (* w8 - *)\n rshift (* w8 - *)\n and (* * - *)\n or (* * - *)\n xor (* * - *)\n\nBitwise operations. Note that right shift is unsigned. A signed version\nwill be added later.\n\n not (* - *)\n\nLogical negation\n\n=== Comparison\n\n lt_u (* * - w)\n lt_s (* * - w)\n gt_u (* * - w)\n gt_s (* * - w)\n eq (* * - w)\n\nLess than and greater than on unsigned and signed data. Note that the\nresult is always fast word width. Likewise conditional instructions always\ntake their argument in the fast word width.\n\n=== Stack manipulation\n\nStack manipulation instructions don't care about data width, the machine\nconceptually places all data in the same sized slots.\n\n drop N\n\nDrop the top _N_ items from the stack.\n\n roll N\n\nRotate the top _N_ items on the stack. The top _N_-1 items move to the\ndown, the lowest item becomes the highest.\nNote that +roll 2+ is the same as +swap+.\n\n pick N\n\nPush the _N_th item on the stack to the top of the stack. Note that +pick 1+\nis the same as \"dup\"\n\n=== Calls\n\n call ClosureId (-)\n call ImportId (-)\n call ProcId (-)\n call_ind (ptr -)\n\nCall the given item as follows:\n\n. Push the value of the instruction pointer and environment pointer onto the\n return stack.\n\n. If indirect version:\n\n.. Pop the top-of-stack and let this be the closure in the next stanza.\n\n. If closure, import or indirect version:\n\n.. Deconstruct the closure that ClosureId/ImportId refers to.\n\n.. Load the instruction pointer with the address of the first instruction in the\n first block of the procedure the closure references.\n\n.. Load the environment register with the environment referred to by the\n clousre.\n\n. If proc version:\n\n.. Load the instruction pointer with the address of the first instruction in the\n first block of the procedure that ProcId.\n\nThe order of the return address and environment on the stack are not\nspecified, provided that the call instructions and +ret+ instruction agree\nabout the order.\n\nBecause the Proc version does not change the +ENV+ register, it is slightly\nfaster. It is only possible for intra-module calls.\n\nThere are tailcall versions of each of the above:\n\n tcall ClosureId (-)\n tcall ImportId (-)\n tcall ProcId (-)\n tcall_ind (ptr -)\n\nThese are defined the same as above except they skip step 1.\n\n ret (-)\n\nPop two values off the return stack, place the return address into the\ninstruction pointer register, and the saved environment in the environment\naddress register.\n\n=== Jumps: jmp, cjmp\n\n jmp BlockId (-)\n\nJump unconditionally to the indicated block by loading the address of the\nfirst instruction of the block into the instruction pointer.\n\nNote that only blocks can be the target of jump instructions, this way all\njmp targets are known.\n\n cjmp BlockId (w -)\n\nPop a value of the expression stack, if it is non-zero load the address of\nthe first instruction of the given block into the instruction pointer.\n\nNote that this instruction always consumes the value on the stack.\n\nTODO: indirect jumps or some mechanism for computed gotos.\n\n=== Make closure\n\n make_closure ProcId (ptr - ptr)\n\nForm a closure from the given procedure and the structure pointed to by the\nTOS. Return the new closure on the TOS.\n\nIt would be possible to make closures a special type of struct, such as a\nstruct whose first argument is a function pointer. This would use less\nmemory and could be used by further optimisations. However we've chosen to\nget closures working with this more naive method and probably change it\nlater.\n\nAlso, closures could be implemented entirely within the compiler. However\nby making them a PZ machine construct we can take advantage of them for\ncode loading and potentially other things.\n\n=== Loops\n\nTODO: Some loops may be handled differently than using blocks and jumps,\n\n=== Data\n\n==== Load immediate number\n\n N (- *)\n\nLoads the immediate value onto the expression stack. (N is any value).\n\n==== Load code reference\n\n ImportId (- ptr)\n\nAKA: load_named, Loads the address of the closure referenced by ImportId.\n\n==== Load and store memory\n\n load StructId FieldNum (ptr - * ptr)\n\nRead the value of a field from the object at the given address.\n_StructId_ and _FieldNum_ are literal.\n\n store StructId FieldNum (* ptr - ptr)\n\nStore a value into the field of an object at the given address.\n\nTODO: Make sure that we can easily handle memory barriers for GC.\n\nTODO: Ordinary and array loads and stores.\n\n==== Memory allocation\n\n alloc StructId (- ptr)\n alloc_mutable StructId (- ptr)\n\n alloc_array ElementWidth (w - ptr)\n alloc_array_mutable ElementWidth (w - ptr)\n\nThe contents of structures and arrays are initialised with the store\ninstruction, including immutable structures and arrays. Immutability is not\nyet enforced or even used, in the future we may add a \"fix\" operation to say\nthat we're done initialising a structure, or otherwise require this\nimplicity before the next allocation or call occurs.\n\nThe GC among other things will use immutability information to optimise its\nalgorithms.\nPlasma will use immutable structures more often than mutable ones, so\nimmutable is the \"normal\" type, and a mutable type has not yet been\nintroduced.\n\n==== Retrive environment\n\nThe environment is a pointer to a struct stored in the +ENV+ register.\nThe register can be read with:\n\n get_env (- ptr)\n\nThen the resulting pointer can be used as a regular struct.\n\n== Garbage collection\n\nThe Garbage Collector must be aware of which values are pointers and which\nare not. Above we explained how information about structures can be used to\ncalculate this for typical heap cells.\n\nThis information must also be available for stack frames. There are\nmultiple ways to make this available at runtime. One simple solution is at\neach GC save point execute code that updates a word in the stack frame\ncontaining a bitfield that specifies which stack slots contain a pointer\ninto the heap.\n\nWe will probably require .pz programs to provide such bitfields within their\ninstruction streams. Since we use separate expression and return stacks it\nwill need to include information about how many of the top stack values\nbelong to the current procedure.\n\n.TODO: Polymorphism\nNOTE: Any polymorphic values will need their \"is a pointer\" bit filled in at\nruntime. We can generate runtime code that takes an argument and constructs\nthe bit field. This information can be passed to the procedure by adding\nextra argument(s) to the procedure, which is how polymorphism\ntransformations work in general.\n\n=== Optimisations\n\nThe objects' bitfields can easily be stored together, as mark bits are\nalready stored in a GC. To save further on memory usage objects with\nparticular layouts can be allocated in particular heap regions. These heap\nregions themselves provide this information. If a heap layout stores object\nsizes with the object, the bitfields for most object sizes could easily be\npacked with the object size.\n\nSome of the information required for stack frames is implicit within the\ninstruction stream. Requiring it to be made explicit makes writing\n+pzrun+ easier, but some of it could be omitted in a later version.\n\n== Builtin operations\n\nSee runtime/pz_builtin.c\n\n.Misc\n----\nprint (ptr -)\nint_to_string (w - ptr)\ndie ()\n----\n\n.Pointer tagging\n----\n// Combine a pointer and a tag into a tagged pointer\nmake_tag (ptr ptr - ptr)\n\n// Combine a word and a tag into a tagged word (shifting the word)\nshift_make_tag (ptr ptr - ptr)\n\n// Extract the pointer and tag from a tagged pointer\nbreak_tag (ptr - ptr ptr)\n\n// Extract the word and tag from a tagged word (shifting the word)\nbreak_shift_tag (ptr - ptr ptr)\n\n// Unshift a tagged value\nunshift_value (ptr - ptr)\n\n----\n\n.Deprecated\n----\nconcat_string (w w - w)\n----\n\n== Linking to other modules\n\nTODO\n\n== Working with foreign code\n\nTODO\n\n== Using PZ\n\n=== A note about data\n\nThe stack cannot be used to store complex data, neither can it be\nintermediate in the instruction stream. Complex data (structs and arrays)\nmust be either statically allocated or allocated on the heap. In either\ncase the PZ machine needs to know about the structure or array being used.\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/references.txt", "content": "Plasma Language References\n==========================\n:Author: Paul Bone\n:Email: paul@plasmalang.org:\n:Date: May 2018\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n\nReferences to 3rd-party papers and software that we are using or that may be\nhelpful at some point.\n\n== Papers, Books & other ideas\n\n=== Closures\n\n* https://pdfs.semanticscholar.org/28b6/d269ebee933c378e539f1c378740d409330d.pdf[Luca Cardelli: Compiling a Functional Language]\n* https://www.cs.indiana.edu/~dyb/pubs/closureopt.pdf[Andrew Keep, Alex Hearn, R. Kent Dybvig: Optimising Closures in O(0) time]\n* http://flint.cs.yale.edu/flint/publications/escc.html[Zhong Shao, Andrew\n Appel: Efficient and Safe for space closure conversion]\n\nMy own blog articles, the second one discusses the two above papers:\n\n* https://paul.bone.id.au/2017/12/03/compiling-closures/[Compiling closures]\n* https://paul.bone.id.au/2017/12/10/compiling-closures2/[More on closures]\n\n=== Continuations\n\nImplementation Strategies for First-class continuations::\nhttp://lampwww.epfl.ch/teaching/archive/advanced_compiler/2006/assignments/part5/continuations.pdf\n\n=== GC References\n\nThe Garbage Collection Handbook::\nhttp://www.amazon.com/Garbage-Collection-Handbook-Management-Algorithms/dp/1420082795/ref=sr_1_1?s=books&ie=UTF8&qid=1437385704&sr=1-1&keywords=garbage+collection\nPotentially useful references from this book::\n* Appel 1989b, Goldberg 1991 about pointer finding\n* Looks like Appel has several good papers about GC\n* Tarditi Compressing stack maps.\n http://research.microsoft.com/pubs/68937/ismm-2000b.pdf\n* Doligez and Leroy 1993 and other papers pp107\n http://gallium.inria.fr/~xleroy/publi/concurrent-gc.pdf\n* Halsteed 1985 concurrent copying\n* Marlow 2008\n* Train collector\n\nRichard Jones' GC Page::\nhttp://www.cs.kent.ac.uk/people/staff/rej/gc.html\n\nRichard Jones' GC Bibiliography::\nhttp://www.cs.kent.ac.uk/people/staff/rej/gcbib/gcbib.html\n\nMemory Management Reference::\nhttp://www.memorymanagement.org/\n\nData structures for GC::\n* http://www.gii.upv.es/tlsf/[TLSF] - a data structure for fast, constant time\n allocation.\n\n=== Type systems\n\n* https://www.mpi-sws.org/~rossberg/1ml/[1ML] is an ML language with the\n module language and value language unified into one language (I think) I\n need to read more.\n\n* http://arxiv.org/pdf/1512.01895.pdf[Modular Implicits] is an extension to\n OCaml to add ad-hoc polymorphism to the language. This is similar to my\n vague ideas about implicit\n link:plasma_ref.html#_interfaces[interfaces],\n and I will probably use this in some way.\n\n* https://www.koterpillar.com/talks/instances-for-everyone/#18 Alexy's talk\n about deriving things like Eq, Ord etc in Haskell/GHC. Contains further\n links at the end.\n\n=== Optimiation and code gneeration\n\n* Frances Allen, 1971: A cataloge of Optimizing Transformations\".\n\n Inline, Unroll, CSE, DCE, Code Motion, Constant Fold, Peephole.\n Alledgedly these give 80% of the best case of all optimisations.\n\n Unfortunately I couldn't find this paper. The referece came from a slide\n deck by Gradon Hoare.\n\n* http://www.agner.org/optimize/ Software optimization resources\n\n* https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/compilingml.pdf\n Compiling a Functional Language.\n\n* Open Watcom code generator is said to be well documented:\n https://github.com/open-watcom/open-watcom-v2/tree/master/bld/cg\n\n=== Concurrency and parallelism\n\n * \"nurseries\" idea for making concurrency more structured, examples in\n Python: https://vorpus.org/blog/notes-on-structured-concurrency-or-go-statement-considered-harmful/\n * Pi-Calculus:\n * On wikipedia\n * A book: The π-calculus: A Theory of Mobile Processes by Davide\n Sangiorgi & David Walker.\n * Languages with parallelism ideas we might be able to borrow:\n ** Chapel language is a parallel programming language for HPC and may have\n some ideas / optimisations we can borrow: https://chapel-lang.org\n ** http://www2.cmp.uea.ac.uk/~jrwg/Sisal/00.Contents.html[SISAL] rivaled\n Fortran's performance and included parallel support for array\n computations.\n\n=== Text handling\n\nUnicode.org::\nhttps://unicode.org/\nUnicode standardisation happens here. I've found the \nhttps://unicode.org/glossary/[Unicode glossary] especially useful, the\nhttps://www.unicode.org/ucd/[Unicode database] may also be helpful.\n\nThe UTF-8 Manifesto::\nhttps://utf8everywhere.org/\nNot a library, but a description of some best practices and calls out some\nworst-practices also.\n\n== Libraries\n\n=== Message Passing\n\nNanomsg::\nhttp://nanomsg.org/\n+\nNanomsg is a C library for message passing. It exposes a BSD sockets style\nAPI.\n\n=== Profiling\n\nSHIM::\nhttps://github.com/ShimProfiler/SHIM\nSHIM is a tool for high-resolution sampling of CPU performance counters. It\nmay be more useful as a basis of our own implementation than useful as-is.\n\n=== Text handling\n\nlibunistring::\nhttps://www.gnu.org/software/libunistring/[libunistring] is the Unicode\nlibrary with the clearest documentation.\nIt might not do everything that we eventually want but it looks like the\nbest place to start.\n\n== Tools\n\n=== Build systems\n\nAutosetup::\nhttp://msteveb.github.io/autosetup/\nAutosetup is an alternative to autoconf, it is written in Tcl.\n\nninja::\nhttps://ninja-build.org\nNinja is a build system (like make) but more principled. It requires build\nfiles to (almost) fully describe the dependency graph (no implicit\nrules/wildcards). This makes things more predictable and faster - but the\nbuild files are usually generated. The `plzbuild` tool writes ninja build\nfiles and calls to ninja to perform the actual build.\n\nTup::\nhttp://gittup.org/tup/index.html\nTup is an alternative to Make. It looks like it avoids a lot of Make's\nproblems.\n\n=== Testing\n\nHyperfine::\nhttps://github.com/sharkdp/hyperfine\nHyperfine is a benchmarking tool.\n\nTAP::\nhttps://testanything.org/\nTest anything protocol a format and set of libraries for test output.\nAllowing a test suite to interact with CI.\n\n=== Git/Project hosting\n\ngitlab::\nSoftware.\n\ngitgud.io::\nGitlab hosted service.\n\ngogs.io::\nGit oriented project hosting written in Go.\n\n=== C Static analysis\n\nsplint::\nhttp://www.splint.org/\n\n== Formats\n\nWe use the https://toml.io/en/[TOML] file format for Plasma BUILD.plz files.\n\n== Algorithms\n\n=== PRNGs\n\nA table of some http://www.pcg-random.org/[PRNGs].\n\n== Related programming languages\n\nPlasma is implemented in https://mercurylang.org[Mercury].\n\nPlasma is inspired by many other languages, some of them are:\n\n* https://mercurylang.org[Mercury] is a logic/functional language that I\n also work on. I developed an auto-parallelisation system for Mercury and\n plan to implement one for Plasma. After 7 years contributing to Mercury\n I'm sure other aspects of it will also influence Plasma.\n* https://en.wikipedia.org/wiki/Hope_%28programming_language%29[Hope]\n influenced Plasma indirectly. Hope is the first language with abstract\n data types.\n* http://ocaml.org[OCaml]'s parametric modules are the inspiration for\n Plasma's interfaces.\n\nSeveral other imperative/declarative languages like Plasma include:\n\n* http://www2.cmp.uea.ac.uk/~jrwg/Sisal/00.Contents.html[SISAL]\n* http://mars-lang.appspot.com/[Mars]\n* Wybe: https://github.com/pschachte/wybe[on github] or\n http://people.eng.unimelb.edu.au/schachte/papers/wybeintro.pdf[a slide\n deck]\n* http://people.eng.unimelb.edu.au/lee/src/pawns/[Pawns]\n\nDisclosure: Mars, Wybe and Pawns are all developed by colleagues of mine.\n\nOther parallel languages:\n\n* http://www2.cmp.uea.ac.uk/~jrwg/Sisal/00.Contents.html[SISAL] is an\n applicative single-assignment language, like Plasma it has declarative\n semantics and an imperative-ish style. It supported auto-parallelisation\n based on loops and streams and rivaled Fortran form performance.\n* http://futhark-lang.org[Futhark] is an array based language (like APL) for\n GPGPU programming. I don't know much about it at the moment but will be\n reading their papers and following their work.\n* http://halide-lang.org/ A Data-parallel eDSL embedded in C++\n* http://parasail-lang.org/ Looks like an implicitly-parallel language.\n* https://docs.alan-lang.org/about_alan.html[Alan] is a almost\n Turing-complete language with array loops and auto parallelism.\n\n// vim: set syntax=asciidoc:\n" }, { "path": "docs/user_guide.txt", "content": "Plasma User's Guide\n===================\n:Author: Paul Bone\n:Email: paul@plasmalang.org\n:Date: March 2021\n:Copyright: Copyright (C) Plasma Team\n:License: CC BY-SA 4.0\n:toc:\n\nThe user's guide describes how to use the Plasma tools to work with your\nprograms.\n\n== Organising your program\n\nPlasma programs are made up of modules. Each module corresponds to a file\nand also (in our implementation) a compilation unit.\nWhen someone says \"Plasma module\" or \"Plasma file\" you can assume they mean\nthe same thing.\n\n=== Filenames\n\nA Plasma file ends with the extension `.p` and the filename must correspond\nto the module name.\nFiles are checked for modules by ignoring case and the hyphen (`-`) and\nunderscore (`_`) symbols.\n\nIn other words, `my_module.p`, `my-module.p`, `mymodule.p`, `MyModule.p` and\n`My_-_Mo-Du-Le.p` are all legal file names for `MyModule`.\nLikewise the file `my_module.p` could contain any of `MyModule`,\n`my_module`, `mY_MoD_ule` etc.\nWhile `my_file.p` does not match `my_module`.\nThe exception is that `-` is not legal in module names since in Plasma code\nit represents subtraction.\n\n[NOTE]\n.Why does Plasma match filenames loosely?\n====\nSome file systems are case sensitive and others are case insensitive, in\ndifferent ways (storing filenames with case but matching them\ninsensitively).\nMeanwhile not all writing systems have a concept of case.\nRather than make separate rules for different situations so that we can\nsupport different file systems and writing systems; it is simpler\nto avoid making case meaningful.\n====\n\nBy convention module names should be in `UpperCase` and their filenames in\n`snake_case`. These give the best clarity in code and the most\ncompatibility on filesystems.\n\n=== Programs\n\nA plasma program must have at least one module and a `BUILD.plz` file to\ndescribe what's required to build it.\nThe `BUILD.plz` file is a https://toml.io/en/[TOML]-ish\nfile containing one or more TOML tables.\nFor example:\n\n----\n[hello]\ntype = program\nmodules = [ Hello ]\n----\n\nLine one gives the name of the program (as the name of the TOML table).\nThis is the name of the bytecode object that will be produced by `plzbuild`.\nThe table has two keys, `type` and `modules`.\nThe `type` key must be set to the string `program` or Plasma will not\nrecognise it as a program.\nThe `modules` key lists the modules that make up the program. It is an\nerror to import (in source code) a module that's not listed here.\n\n[NOTE]\n.Why does Plasma require this?\n====\nThis gives you one place where you can get an idea of how big and complex\nyour program is,\nwhich becomes harder to tell if there are many programs sharing the same\ndirectory.\n====\n\nThe following example shows a program with multiple modules:\n\n----\n[my_example]\ntype = program\nmodules = [ ModuleExample, ModuleToImport ]\n----\n\nA `BUILD.plz` file may describe more than one program.\nPlasma will check the `BUILD.plz` file for tables whose `type` key\nmatches `program` and interpret each one as a program.\nThis allows the source for multiple programs to live in the same directory.\nFor example.\n\n----\n[program_1]\ntype = program\nmodules = [ Prog1, SharedCode ]\n\n[program_2]\ntype = program\nmodules = [ Prog2, SharedCode ]\n----\n\nThey may even share modules,\nas the above programs both use the `SharedCode` module which is compiled\nonce and used by the two programs.\nIn the future Plasma will also support libraries, but the ability to share\ncode between programs in this way will always be provided.\n\nThis also means that if `SharedCode` imports another module `CommonStuff`,\nthen `CommonStuff` must be in the modules lists of *all* the programs that\ninclude `SharedCode`.\n\n[NOTE]\n.Why share code like this when libraries are more flexible?\n====\nSharing code between multiple related programs can be useful when\ndistributing a library is inconvenient (static linking is another solution)\nor when the shared code is too small to worry about (some utility code).\n====\n\nFuture work:\n\n * link:https://github.com/PlasmaLang/plasma/issues/345[Bug 345 - Don't\n require a BUILD.plz for single-module programs]\n * link:https://github.com/PlasmaLang/plasma/issues/344[Bug 344 - Real TOML\n support]\n * link:https://github.com/PlasmaLang/plasma/issues/316[Bug 316 - Support\n for libraries]\n\n=== Program entrypoints\n\nPrograms must have exactly one entrypoint. This is specified in the source\ncode by placing the `entrypoint` keyword in front of a function definition.\n\n----\nentrypoint\nfunc hello() uses IO -> Int {\n ...\n return 0\n}\n----\n\nThe chosen function must take zero arguments and return an integer.\nFollowing UNIX convention returning 0 from this function means the program\nran successfully and any other value means it failed.\n\nThe entrypoint function's name is irrelevant. There is no need to name your\nfunction `main` or `WinMain`.\n\nIt is syntactically possible to put the entrypoint specifier in front of\nmultiple functions.\nIn the future the linker will be able to choose the actual entrypoint from\nthese candidates, but for now this is unsupported.\n\nFuture work:\n\n * https://github.com/PlasmaLang/plasma/issues/283[#283 - Support command\n line arguments in entrypoints]\n * https://github.com/PlasmaLang/plasma/issues/346[#346 - Specify entrypoint\n in `BUILD.plz`]\n\n== Building programs\n\nPrograms are compiled form source code to bytecode using the `plzbuild` tool.\nEach module is compiled separately and then linked together to create a\nbytecode file for each program.\n\nRunning `plzbuild` with no command line arguments will build every program\nin the current directory's `BUILD.plz` file.\nIt will only rebuild the files/modules as necessary.\n\n----\n$ plzbuild\nninja: Entering directory `_build'\n[4/4] Copying hello bytecode\n----\n\n[NOTE]\n.The hidden details\n====\n`plzbuild` doesn't do its work on its own.\nIt calls upon the services of another program, a ninja,\nthe http://ninja-build.org[the ninja build system] to do the dirty work.\n`plzbuild` creates a `_build` directory and places files in there for\n`ninja`.\nIt then executes `ninja` to calculate dependencies and execute the compiler\nand linker with the right arguments to build your programs.\n====\n\n`ninja` (invoked by `plzbuild`)\nprints out a description of each command as it runs on a status line.\nThe examples here show the last command to run (copying a bytecode file).\n\n\n`plzbuild` can be given the names of programs to build, and options from the\ntable below.\n\n.plzbuild Options\n|==========================================================================\n| -v, --verbose | Write verbose output\n| --rebuild | Regenerate/rebuild everything regardless of timestamps\n| --report-timing | Report the CPU & elapsed time for each build step \n|==========================================================================\n\nTo build the `fib` and `hello` programs while ignoring any others (eg in the\nPlasma examples):\n\n----\n$ plzbuild hello fib\nninja: Entering directory `_build'\n[8/8] Copying fib bytecode\n----\n\n== Running programs\n\nPlasma bytecode can be interpreted by the `plzrun` program:\n\n----\n$ plzrun hello.pz\nHello world\n----\n\nIf your program dynamically links with other bytecode libraries load them\nwith `-l`.\n\n----\n$ plzrun -l my_library.pz -l another_library.pz my_program.pz\n----\n\nFuture work:\n\n * https://github.com/PlasmaLang/plasma/issues/347[#347 - plzrun should\n automatically locate libraries]\n * https://github.com/PlasmaLang/plasma/issues/348[#348 - Allow direct\n execution of bytecode files]\n\n// vim: set syntax=asciidoc:\n" }, { "path": "examples/.gitignore", "content": "*.diff\n*.log\n*.out\n*.outs\n*.pzo\n*.pz\n*.plasma-dump*\n_build\n" }, { "path": "examples/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# This is a Plasma build file, it will tell Plasma about the programs in\n# this directory and what modules they're made from.\n#\n\n[ackermann]\ntype = program\nmodules = [ Ackermann ]\n\n[change]\ntype = program\nmodules = [ Change, String, Util ]\n\n[fib]\ntype = program\nmodules = [ Fib ]\n\n[hello]\ntype = program\nmodules = [ Hello ]\n\n[modules]\ntype = program\nmodules = [ ModuleExample, ModuleToImport ]\n\n[mr4]\ntype = program\nmodules = [ Mr4 ]\n\n[readline]\ntype = program\nmodules = [ Readline, String, Util ]\n\n[temperature]\ntype = program\nmodules = [ Temperature ]\n\n[types]\ntype = program\nmodules = [ Types, Set ]\n\n" }, { "path": "examples/Makefile", "content": "#\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# vim: noet sw=4 ts=4\n#\n\nTOP=..\n\n.PHONY: all\nall: $(wildcard *.p) $(TOP)/src/plzbuild $(TOP)/src/plzc $(TOP)/src/plzlnk\n\t$(TOP)/src/plzbuild\n\nchange.pz: all\n\ttouch $@\nfib.pz: all\n\ttouch $@\nhello.pz: all\n\ttouch $@\nmodules.pz: all\n\ttouch $@\nmr4.pz: all\n\ttouch $@\nreadline.pz: all\n\ttouch $@\ntemperature.pz: all\n\ttouch $@\ntypes.pz: all\n\ttouch $@\n\n.PHONY: %.test\n%.test : %.exp %.outs\n\tdiff -u $^\n\n%.outs : %.out\n\tgrep -v '^#' < $< | sed -e 's/#.*$$//' > $@\n\n%.out : %.pz $(TOP)/runtime/plzrun\n\t$(TOP)/runtime/plzrun $< > $@\n\nchange.out : change.pz $(TOP)/runtime/plzrun\n\techo \"1234\\n 4321 \\n7\" | $(TOP)/runtime/plzrun $< > $@\n\nreadline.out : readline.pz $(TOP)/runtime/plzrun\n\techo \"Paul Bone\\n\\n \\nI am a fish \\n FISH\" | $(TOP)/runtime/plzrun $< > $@\n\n.PHONY: clean\nclean:\n\trm -rf *.pz *.out *.outs *.diff *.log _build\n\n.PHONY: realclean\nrealclean: clean\n\trm -rf *.plasma-dump_*\n\n" }, { "path": "examples/README.md", "content": "# Plasma Example Programs\n\n* [fib](fib.p) - Fibonacci program demonstrating control flow\n* [hello](hello.p) - Hello World\n* [mr4](mr4.p) - Mr 4's first computer program\n* [types](types.p) - Some example type declarations\n* [temperature](temperature.p) - Basic expressions\n* [sequences](sequences.p) - How to use sequences (lists, arrays and\n streams) in plasma\n* modules - An example of importing a module from another, and building a\n multi-module program. Made of [module\\_example.p](module_example.p)\n and [module\\_to\\_import.p](module_to_import.p).\n\n" }, { "path": "examples/ackermann.exp", "content": "ack(3, 9) = 4093\n" }, { "path": "examples/ackermann.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Ackermann\n\nentrypoint\nfunc main() uses IO -> Int {\n test_ack!(3, 9)\n return 0\n}\n\nfunc test_ack(m : Int, n : Int) uses IO {\n var ans = ack(m, n)\n\n var m_str = int_to_string(m)\n var n_str = int_to_string(n)\n var ans_str = int_to_string(ans)\n\n print!(\"ack(\" ++ m_str ++ \", \" ++ n_str ++ \") = \" ++ ans_str ++ \"\\n\")\n}\n\nfunc ack(m : Int, n : Int) -> Int {\n return if m == 0\n then n + 1\n else if n == 0\n then ack(m - 1, 1)\n else ack(m - 1, ack(m, n - 1))\n}\n\n" }, { "path": "examples/change.exp", "content": "Type a number of cents to give as change: Trimmed string is: 1234.\nWhich is the value: $12.34\nTo give this amount in /perfect/ change you should give:\n6 x $2\n1 x 20c\n1 x 10c\n4 x 1c\nType a number of cents to give as change: Trimmed string is: 4321.\nWhich is the value: $43.21\nTo give this amount in /perfect/ change you should give:\n21 x $2\n1 x $1\n1 x 20c\n1 x 1c\nType a number of cents to give as change: Trimmed string is: 7.\nWhich is the value: $0.07\nTo give this amount in /perfect/ change you should give:\n1 x 5c\n2 x 1c\nType a number of cents to give as change: \n" }, { "path": "examples/change.in", "content": "1234\n 4321 \n7\n" }, { "path": "examples/change.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Change\n\nimport String\nimport Util\n\nentrypoint\nfunc main() uses IO -> Int {\n // Plasma should add while loops as well as the planned for loops. This\n // is a good example of where a while loop would be helpful.\n func loop() uses IO -> Bool {\n print!(\"Type a number of cents to give as change: \")\n match (readline!()) {\n Ok(var line) -> {\n var str = String.trim(line)\n if (not string_equals(str, \"\")) {\n print!(\"Trimmed string is: \" ++ str ++ \".\\n\")\n var num = String.str_to_num(str)\n print!(\"Which is the value: \" ++ currency_str(num) ++\n \"\\n\")\n var coins = change(num)\n print!(\"To give this amount in /perfect/ change you \" ++\n \"should give:\\n\")\n Util.do_for!(print_coin, coins)\n return True\n } else {\n return False\n }\n }\n EOF -> {\n return False\n }\n }\n }\n\n Util.while!(loop)\n\n return 0\n}\n\nfunc currency_str(num : Int) -> String {\n var cents = num % 100\n var dollars = num / 100\n return \"$\" ++ int_to_string(dollars) ++ \".\" ++ \n (if cents < 10 then \"0\" else \"\") ++ \n int_to_string(cents)\n}\n\ntype CoinNum = CoinNum ( \n c : Coin,\n n : Int\n)\n\ntype Coin = c1\n | c5\n | c10\n | c20\n | c50\n | d1\n | d2\n\nfunc change(n : Int) -> List(CoinNum) {\n if (n < 1) {\n return []\n } else {\n var coin\n var value\n if n >= 200 {\n coin = d2\n value = 200\n } else if n >= 100 {\n coin = d1\n value = 100\n } else if n >= 50 {\n coin = c50\n value = 50\n } else if n >= 20 {\n coin = c20\n value = 20\n } else if n >= 10 {\n coin = c10\n value = 10\n } else if n >= 5 {\n coin = c5\n value = 5\n } else {\n coin = c1\n value = 1\n }\n\n var num = n / value\n var rem = n - value * num\n return [CoinNum(coin, num) | change(rem)] \n }\n}\n\nfunc coin_name(coin : Coin) -> String {\n return match (coin) {\n c1 -> \"1c\"\n c5 -> \"5c\"\n c10 -> \"10c\"\n c20 -> \"20c\"\n c50 -> \"50c\"\n d1 -> \"$1\"\n d2 -> \"$2\"\n }\n}\n\nfunc print_coin(c : CoinNum) uses IO {\n CoinNum(var coin, var num) = c\n print!(int_to_string(num) ++ \" x \" ++ coin_name(coin) ++ \"\\n\")\n}\n\n" }, { "path": "examples/fib.exp", "content": "fib1(16) = 1597\nfib2(16) = 1597\nfib3(16) = 1597\nfib4(16) = 1597\nfib5(16) = 1597\nfib6(16) = 1597\n" }, { "path": "examples/fib.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n/*\n * This example shows conditional statements and expressions, using\n * if-then-elses and pattern matches.\n */\n\nmodule Fib\n\nentrypoint\nfunc main() uses IO -> Int {\n var n = 16 \n\n var n_str = int_to_string(n)\n func label(m : Int) -> String {\n return \"fib\" ++ int_to_string(m) ++ \"(\" ++ n_str ++ \") = \"\n }\n\n print!(label(1) ++ int_to_string(fib1(n)) ++ \"\\n\")\n print!(label(2) ++ int_to_string(fib2(n)) ++ \"\\n\")\n print!(label(3) ++ int_to_string(fib3(n)) ++ \"\\n\")\n print!(label(4) ++ int_to_string(fib4(n)) ++ \"\\n\")\n print!(label(5) ++ int_to_string(fib5(n)) ++ \"\\n\")\n print!(label(6) ++ int_to_string(fib6(n)) ++ \"\\n\")\n return 0\n}\n\nfunc fib1(n : Int) -> Int {\n if (n <= 1) {\n return 1\n } else {\n return fib1(n-1) + fib1(n-2)\n }\n}\n\n// Or branches can set a variable:\nfunc fib2(n : Int) -> Int {\n var r\n if (n <= 1) {\n r = 1\n } else {\n r = fib2(n-1) + fib2(n-2)\n }\n return r\n}\n\n// Or if-then-else can be an expression:\nfunc fib3(n : Int) -> Int {\n return if (n <= 1) then 1 else fib3(n-1) + fib3(n-2)\n}\n\n// Or, using pattern matching:\nfunc fib4(n : Int) -> Int {\n match (n) {\n 0 -> {\n return 1\n }\n 1 -> {\n return 1\n }\n // Any symbols here must be constructor symbols or free variables.\n var m -> {\n return fib4(m-1) + fib4(m-2)\n }\n }\n}\n\n// Or, using pattern matching that sets a value:\nfunc fib5(n : Int) -> Int {\n var r\n match (n) {\n 0 -> {\n r = 1\n }\n 1 -> {\n r = 1\n }\n // Any symbols here must be constructor symbols or free variables.\n var m -> {\n r = fib5(m-1) + fib5(m-2)\n }\n }\n\n return r\n}\n\n// Or, pattern matching can be an expression.\nfunc fib6(n : Int) -> Int {\n return match (n) {\n 0 -> 1\n 1 -> 1\n // Any symbols here must be constructor symbols or free variables.\n var m -> fib6(m-1) + fib6(m-2)\n }\n}\n\n// // Pattern matching can also include guards.\n// func fib7(n : Int) -> Int {\n// return match (n) {\n// m | m < 2 -> 1\n// m | otherwise -> fib7(m-1) + fib7(m-2)\n// }\n// }\n\n" }, { "path": "examples/hello.exp", "content": "Hello world\n" }, { "path": "examples/hello.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n// Module declaration, this sets the name of the module.\nmodule Hello\n\n// The entrypoint function, there's multiple things in the signature:\n// * It has zero parameters but in the future in the future it will\n// probably take an argument for command line options.\n// * It returns Int.\n// * It uses the IO resource.\n// * It is marked as an entrypoint, rather than in C and many other\n// languages it doesn't need a special name.\n\nentrypoint\nfunc hello() uses IO -> Int {\n // the ! indicates that this call uses a resource, which resource is\n // determined automatically.\n print!(\"Hello world\\n\")\n\n // 0 is the operating system's exit code for success. This should be\n // symbolic in the future.\n return 0\n}\n\n" }, { "path": "examples/module_example.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n// The filename is module_example, note that they don't have to match by case\n// or underscores.\nmodule ModuleExample\n\n// Import a module\nimport ModuleToImport\n\nentrypoint\nfunc main() uses IO -> Int {\n ModuleToImport.test!()\n return 0\n}\n\n" }, { "path": "examples/module_to_import.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n// The filename is module_example, note that they don't have to match by case\n// or underscores.\nmodule ModuleToImport\n\n\n// Resources may be exported\nexport\nresource MyRes from IO\n\n// Types may be exported (the constructors and fields are exported too)\nexport\ntype MyMaybe('x) = Nothing\n | Some(x : 'x)\n\n// Or opaque-exported (the constructors and fields are not exported)\nexport opaque\ntype Tree('k, 'v) = Empty \n | Node(\n k : 'k,\n v : 'v,\n l : Tree('k, 'v),\n r : Tree('k, 'v)\n )\n\n// Functions may be exported.\nexport\nfunc test() uses IO {\n print!(\"Hello from ModuleToImport\\n\")\n}\n\n" }, { "path": "examples/modules.exp", "content": "Hello from ModuleToImport\n" }, { "path": "examples/mr4.exp", "content": "Hello Mr 4\nGoodbye Mr 4\nHello Daddy\nGoodbye Daddy\nHello Mummy\nGoodbye Mummy\n" }, { "path": "examples/mr4.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Mr4\n\n/*\n * This is Mr 4's first computer program, 2019-12-01. Okay so he had some\n * help but I'm still impressed that he understood variables (but not\n * functions).\n */\nentrypoint\nfunc main() uses IO -> Int {\n func greeting(name : String) uses IO {\n print!(\"Hello \" ++ name ++ \"\\n\")\n print!(\"Goodbye \" ++ name ++ \"\\n\")\n }\n\n // Name redacted until he can consent to internet privacy.\n greeting!(\"Mr 4\") \n greeting!(\"Daddy\")\n greeting!(\"Mummy\")\n\n return 0\n}\n\n" }, { "path": "examples/readline.exp", "content": "What's your name (empty to exit)? Hello Paul Bone.\nWhat's your name (empty to exit)? Hello .\nWhat's your name (empty to exit)? Hello .\nWhat's your name (empty to exit)? Hello I am a fish.\nWhat's your name (empty to exit)? Hello FISH.\nWhat's your name (empty to exit)? Some trim examples:\nTrim of '' is ''\nTrim of ' ' is ''\nTrim of ' Paul' is 'Paul'\nTrim of 'Paul ' is 'Paul'\nTrim of ' Paul Bone ' is 'Paul Bone'\nTrim of ' \na quick brown fox \t ' is 'a quick brown fox'\n" }, { "path": "examples/readline.in", "content": "Paul Bone\n\n \nI am a fish \n FISH\n" }, { "path": "examples/readline.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Readline\n\nimport String\nimport Util\n\nentrypoint\nfunc hello() uses IO -> Int {\n func loop() uses IO -> Bool {\n print!(\"What's your name (empty to exit)? \")\n // Readline returns a line from standard input without the newline\n // character.\n var name_res = readline!()\n match (name_res) {\n Ok(var name) -> {\n print!(\"Hello \" ++ String.trim(name) ++ \".\\n\")\n return True\n }\n EOF -> {\n return False\n }\n }\n }\n Util.while!(loop)\n\n print!(\"Some trim examples:\\n\")\n func do_ex(s : String) uses IO {\n print!(\"Trim of '\" ++\n s ++ \n \"' is '\" ++\n String.trim(s) ++\n \"'\\n\")\n }\n map!(do_ex, [\"\", \" \", \" Paul\", \"Paul \", \" Paul Bone \",\n \" \\na quick brown fox \\t \"])\n\n // 0 is the operating system's exit code for success. This should be\n // symbolic in the future.\n return 0\n}\n\nfunc map(f : func('x) uses IO, l : List('x)) uses IO {\n match (l) {\n [] -> {}\n [var x | var xs] -> {\n f!(x)\n map!(f, xs)\n }\n }\n}\n\n" }, { "path": "examples/sequences.p", "content": "# vim: ft=plasma\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# This example of lists, streams and arrays is not yet supported.\n\nmodule Sequences\n\nexport main\n\nimport io\n\nfunc main() uses IO -> Int {\n print!(\"lists\\n\")\n list = [1, 2, 3, 4]\n list2 = [0 | list]\n # cons several items at once.\n list3 = [-2, -1, 0 | list]\n\n # for x in list2 {\n # print!(show(x) ++ \"\\n\")\n # }\n\n print!(\"arrays\\n\")\n array = [: 1, 2, 3, 4 :]\n # for x in array {\n # ! print(show(x) ++ \"\\n\")\n # }\n # An array can be subscripted (1-based).\n print!(\"The second element in the array is: \" ++ show(array[2]) ++\n \"\\n\")\n # including assignment (array must be unique)\n array[2] <= 23\n # And indexed from the end.\n# print!(\"the second last element is: \" ++ show(array[-2]) ++ \"\\n\")\n # BUT the - symbol in the subscript is special, it means \"count from the\n # end\" and not \"minus\". The actual expression must be an unsigned\n # integer type. This cannot be implemented with the current parser.\n\n# # Or sliced (the syntax is Expr? '..' Expr?\n# array2 = array[1..3] # first two elements.\n# array3 = array[2..4] # 2nd and 3rd elements from the middle of the\n# # array\n# array4 = array[3..] # 3rd element to the end.\n# array5 = array[..3] # first two elements\n# # Minuses can be used to position from the end.\n# array6 = array[-3..] # 3rd last to end elements\n# array7 = array[..-1] # All but the last element\n# array8 = array[-3..-1] # 3rd and 2nd last elements\n\n # ! print(\"streams\\n\")\n # A stream may be part of a producer/consumer parallelism, maybe being\n # produced by another thread. Or it may be lazy, being produced by\n # evaluating thunks in this thread, or already evaluated.\n # Streams do not need a syntax for constants the way lists and arrays\n # do, since they are either created lazily or concurrently. Likewise\n # streams are usually consumed with a loop. So I haven't defined any\n # syntax for them yet. However I'm considering using [- -] symbols for\n # streams, possibly with comprehensions.\n # TODO: some stream examples..\n\n # Lists, arrays and streams can all be concatenated with sequences of\n # the same time (eg lists and lists) using the ++ operator.\n list4 = list ++ list2\n\n # I believe I will use the { } brackets for dictionaries.\n\n # Another idea, maybe N..M is syntax for a sequence of N to M\n # inclusive. It could either be polymorphic (returning the sequence of\n # the desired type) or be used within brackets eg for a list: [ 1..10 ].\n # The latter makes things clear but the former looks good in\n # comprehensions. I will decide later.\n\n return 0\n}\n\n" }, { "path": "examples/set.p", "content": "// vim: ft=plasma\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule Set\n\nexport\ntype Set('t) = Set(items : List('t))\n\n" }, { "path": "examples/string.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule String\n\nexport\nfunc trim(s : String) -> String {\n return trim_right(trim_left(s))\n}\n\n/*\n * This might be how we implement this in the future, but we lack the\n * language features:\n * * while loops\n * * state variables\n * * object.func() syntax\n */\n/*\nfunc trim_left(s : String) -> String {\n var $pos = s.begin()\n\n while not $pos.at_end() {\n if $pos.next_char().class() != WHITESPACE\n break\n $pos = $pos.next()\n }\n\n return string_substring($pos, s.end())\n}\n*/\n\nfunc trim_left(s : String) -> String {\n func loop(pos : StringPos) -> String {\n match (strpos_next(pos)) {\n Some(var c) -> {\n match codepoint_category(c) {\n Whitespace -> { return loop(strpos_forward(pos)) }\n Other -> { return string_substring(pos, string_end(s)) }\n }\n }\n None -> {\n // We're at the end of the string\n return \"\"\n }\n }\n }\n\n return loop(string_begin(s))\n}\n\nfunc find_last(test : func(CodePoint) -> Bool,\n string : String) -> StringPos {\n func loop(pos : StringPos) -> StringPos {\n // We can't fold these tests into one because Plasma's || isn't\n // necessarily short-cutting.\n match (strpos_prev(pos)) {\n Some(var c) -> {\n if test(c) {\n return pos\n } else {\n return loop(strpos_backward(pos))\n }\n }\n None -> {\n return pos\n }\n }\n }\n\n return loop(string_end(string))\n}\n\nfunc trim_right(s : String) -> String {\n func is_not_whitespace(c : CodePoint) -> Bool {\n return match (codepoint_category(c)) {\n Whitespace -> False\n Other -> True\n }\n }\n\n return string_substring(string_begin(s), find_last(is_not_whitespace, s))\n}\n\nexport\nfunc str_to_num(s : String) -> Int {\n var base = 10\n\n func loop(pos : StringPos, num : Int) -> Int {\n var maybe_cp = strpos_next(pos)\n match (maybe_cp) {\n None -> {\n // End of input.\n return num\n }\n Some(var cp) -> {\n var maybe_digit = codepoint_to_digit(cp)\n match (maybe_digit) {\n Some(var digit) -> {\n return loop(strpos_forward(pos), num * base + digit)\n }\n None -> {\n // Could make this function return a maybe.\n Builtin.die(\"Bad number\")\n return 0\n }\n }\n }\n }\n }\n return loop(string_begin(s), 0)\n}\n\nfunc codepoint_to_digit(cp : CodePoint) -> Maybe(Int) {\n var num = codepoint_to_number(cp)\n // Recognise the digits range within ASCII, I don't know if there are\n // other ranges for numbers in Unicode.\n if num <= 57 and num >= 48 {\n return Some(num - 48)\n } else {\n return None\n }\n}\n\n" }, { "path": "examples/temperature.exp", "content": "26c is 78f\n38c is 100f\n0c is 32f\n100c is 212f\n-40c is -40f\n" }, { "path": "examples/temperature.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Temperature\n\nentrypoint\nfunc main() uses IO -> Int {\n run!(26)\n run!(38)\n run!(0)\n run!(100)\n run!(-40)\n return 0\n}\n\nfunc run(c : Int) uses IO {\n var f = c_to_f(c)\n print!(int_to_string(c) ++ \"c is \" ++ int_to_string(f) ++ \"f\\n\")\n}\n\nfunc c_to_f(c : Int) -> Int {\n return c * 9 / 5 + 32\n}\n\n" }, { "path": "examples/types.exp", "content": "Types example doesn't actually do anything with the types\n" }, { "path": "examples/types.p", "content": "// vim: ft=plasma\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule Types \n\n/*\n * This example doesn't yet compile. The uncommented code requires a type\n * alias for Number and the module system and a Set module.\n */\n\n// We can define our own types.\n\n// A simple enum\ntype Suit = Hearts | Diamonds | Spades | Clubs\ntype Number = Ace\n | One\n | Two\n | Three\n | Four\n | Five\n | Six\n | Seven\n | Eight\n | Nine\n | Ten\n | Jack\n | Queen\n | King\n\n// A structure: a single constructor with fields.\ntype PlayingCard = Card ( suit : Suit, number : Number )\n\n// A combination of the above, a PlayingCard is either an ordinary card or a\n// joker. An orderinary card has fields.\ntype PlayingCardOrJoker = OrdinaryCard ( suit : Suit, number : Number )\n | Joker\n\n// Types are polymorphic, they may take type parameters.\ntype Tree('k, 'v) = EmptyTree\n | Node (\n key : 'k,\n value : 'v,\n left : Tree('k, 'v),\n right : Tree('k, 'v)\n )\n\n// Test that module qualifiers work on type expressions.\nimport Set\n\ntype MyType = MyConstr (\n field : Set.Set(Int)\n )\n\n//\n// Type Aliases\n//\n//\n//# A type alias, ID is now another word for Int.\n//type_alias ID = Int\n//\n//# It's often more useful to alias something more complex.\n//type_alias Name = String\n//type_alias NameMap = Map(ID, Name)\n//\n//# Type aliases can take parameters:\n//type_alias IDMap(x) = Map(ID, x)\n//\n\n\n// Empty main function.\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"Types example doesn't actually do anything with the types\\n\")\n return 0\n}\n\n" }, { "path": "examples/util.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Util\n\nexport\nfunc while(f : func() uses IO -> Bool) uses IO {\n var res = f!()\n if (res) {\n while!(f)\n } else {\n }\n}\n\nexport\nfunc do_for(f : func('x) uses IO, l : List('x)) uses IO {\n match (l) {\n [] -> {}\n [var x | var xs] -> {\n f!(x)\n do_for!(f, xs)\n }\n }\n}\n\n" }, { "path": "runtime/.gitignore", "content": "*.o\nplzrun\ntags\npz_config.h\n" }, { "path": "runtime/README.md", "content": "# Plasma Runtime System\n\nPlasma uses a byte code interpreter. One basic interpreter and runtime\nsystem is currently under development but this could change in the future,\nincluding the addition of native code generation.\n\n## Files\n\nThe runtime is mostly C++ with small bits of C, some care needs to be taken\nwith header files. C++ may call C (and include its headers) but C may not\ncall C++ or include its headers (without wrappers).\n\nThese files break the rule about having matching implementation/header files\nfor each module. Since for these headers, multiple alternative files could\nprovide different implementations.\n\n* [pz\\_interp.h](pz\\_interp.h) - The header file for the core of the\n interpreter\n* [pz\\_closure.h](pz\\_closure.h) - Header file with closure related\n declrations. The implementation is in\n the interpreter files themselves.\n* [pz\\_generic.cpp](pz\\_generic.cpp) - The architecture independent (and only)\n implementation of the interpreter\n* pz\\_generic\\_\\*.{cpp,h} - Other parts of the generic interpreter. Only files\n in this group may include other headers in this\n group, there must be no coupling with the rest of\n the system other than trhough pz_interp.h\n* [pz\\_generic\\_run.cpp](pz\\_generic\\_run.cpp)/[pz\\_generic\\_run.h](pz\\_generic\\_run.h) - The main loop of the interpreter.\n* [pz\\_generic\\_builtin.cpp](pz\\_generic\\_builtin.cpp)/[pz\\_generic\\_builtin.h](pz\\_generic\\_builtin.h) - The implementation of the builtins.\n\nOther files that may be interesting are:\n\n* [pz\\_main.cpp](pz\\_main.cpp) - The entry point for pzrun\n* [pz\\_option.cpp](pz\\_option.cpp) - Option processing for pzrun\n* [pz\\_instructions.h](pz\\_instructions.h) and\n [pz\\_instructions.c](pz\\_instructions.c)\n Instruction data for the bytecode format\n* [pz.h](pz.h)/[pz.cpp](pz.cpp),\n [pz\\_code.h](pz\\_code.h)/[pz\\_code.cpp](pz\\_code.cpp) and\n [pz\\_data.h](pz\\_data.h)/[pz\\_data.cpp](pz\\_data.cpp) -\n Structures used by pzrun\n* [pz\\_gc.h](pz\\_gc.h) and other pz\\_gc\\* files - The garbage collector is\n across several files here.\n - [pz\\_gc\\_util.h](pz\\_gc\\_util.h) contains an API that allows the GC to\n find roots in C++ code and determine when GC is safe.\n - [pz\\_gc\\_layout.h](pz\\_gc\\_layout.h) declares the heap structure.\n* [pz\\_format.h](pz\\_format.h) - Constants for the PZ bytecode format\n* [pz\\_read.h](pz\\_read.h)/[pz\\_read.cpp](pz\\_read.cpp) -\n Code for reading the PZ bytecode format\n\n## Build Options\n\n * PZ\\_DEV - Enable developer build which makes the PZ\\_RUNTIME\\_DEV\\_OPTS\n below available.\n\n * DEBUG - Enable runtime assertions.\n\n## Runtime Options\n\nRuntime options are specified using environment variables. They're each\ninterpreted as comma-seperated, case-sensative tokens.\n\n * PZ\\_RUNTIME\\_OPTS for general runtime options.\n\n * load\\_verbose - verbose loading messages\n\n * fast\\_exit=[ yes | no ] - exit without freeing resources.\n\n * PZ\\_RUNTIME\\_DEV\\_OPTS for developer runtime options.\n \n These require PZ\\_DEV to be defined during compile time.\n\n * interp\\_trace - tracing of PZ bytecode interpreter\n\n * gc\\_zealous - Make the GC zealously perform a GC before every\n allocation. To test this mode run:\n ( cd tests; ./run-tests.sh gc )\n\n" }, { "path": "runtime/pz.cpp", "content": "/*\n * Plasma in-memory representation\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n#include \n\n#include \"pz_code.h\"\n#include \"pz_data.h\"\n#include \"pz_interp.h\"\n\n#include \"pz.h\"\n\nnamespace pz {\n/*\n * PZ Programs\n *************/\n\nPZ::PZ(const Options & options, Heap & heap)\n : AbstractGCTracer(heap)\n , m_options(options)\n , m_program(nullptr)\n{}\n\n// Defined here rather than the header even though it's a default destructor\n// so that it can access the heap destructor.\nPZ::~PZ() {}\n\nLibrary * PZ::new_library(const String name, GCCapability & gc_cap)\n{\n assert(!m_libraries[name]);\n m_libraries[name] = new (gc_cap) Library();\n return m_libraries[name];\n}\n\nvoid PZ::add_library(const String name, Library * library)\n{\n assert(!m_libraries[name]);\n m_libraries[name] = library;\n}\n\nLibrary * PZ::lookup_library(const String name)\n{\n auto iter = m_libraries.find(name);\n\n if (iter != m_libraries.end()) {\n return iter->second;\n } else {\n return nullptr;\n }\n}\n\nvoid PZ::add_program_lib(Library * program)\n{\n assert(nullptr == m_program);\n m_program = program;\n}\n\nvoid PZ::do_trace(HeapMarkState * marker) const\n{\n for (auto m : m_libraries) {\n marker->mark_root(m.first.ptr());\n marker->mark_root(m.second);\n }\n if (m_program) {\n marker->mark_root(m_program);\n }\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz.h", "content": "/*\n * Plasma in-memory representation\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_H\n#define PZ_H\n\n#include \"pz_common.h\"\n\n#include \n#include \n#include \n\n#include \"pz_library.h\"\n\nnamespace pz {\n/*\n * PZ Programs\n */\nclass PZ : public AbstractGCTracer\n{\n private:\n const Options & m_options;\n std::unordered_map m_libraries;\n Library * m_program;\n\n public:\n explicit PZ(const Options & options, Heap & heap);\n ~PZ();\n\n Library * new_library(const String name, GCCapability & gc_cap);\n\n const Options & options() const\n {\n return m_options;\n }\n\n /*\n * Add a library to the program.\n *\n * The main program library (it is a Library class) is not added in this\n * way.\n *\n * The name will be coppied and the caller remains responsible for\n * the original name. The module will be freed by pz_free().\n */\n void add_library(const String name, Library * library);\n\n Library * lookup_library(const String name);\n\n void add_program_lib(Library * module);\n\n Library * program_lib() const\n {\n return m_program;\n }\n\n PZ(const PZ &) = delete;\n void operator=(const PZ &) = delete;\n\n void do_trace(HeapMarkState * marker) const override;\n};\n\n} // namespace pz\n\n#endif /* ! PZ_H */\n" }, { "path": "runtime/pz_array.h", "content": "/*\n * Plasma GC-compatible bounds-checked array\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_ARRAY_H\n#define PZ_ARRAY_H\n\n#include \"string.h\"\n\n#include \"pz_gc_util.h\"\n\nnamespace pz {\ntemplate \nclass Array : public GCNew\n{\n private:\n /*\n * The array data is stored seperately. Array types can be\n * passed-by-value and easilly embeded within other values.\n */\n size_t m_len;\n T * m_data;\n\n public:\n Array(NoGCScope & gc, size_t len) : m_len(len)\n {\n assert(m_len > 0);\n m_data = new (gc) T[len];\n }\n\n const T & operator[](size_t offset) const\n {\n assert(offset < m_len);\n return m_data[offset];\n }\n\n T & operator[](size_t offset)\n {\n assert(offset < m_len);\n return m_data[offset];\n }\n\n void zerofill()\n {\n memset(m_data, 0, sizeof(T) * m_len);\n }\n\n /*\n * These are deleted until they're needed (and can be tested) later.\n */\n Array(const Array &) = delete;\n void operator=(const Array &) = delete;\n};\n\n} // namespace pz\n\n#endif /* ! PZ_ARRAY_H */\n" }, { "path": "runtime/pz_builtin.cpp", "content": "/*\n * Plasma builtins\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \"pz_builtin.h\"\n#include \"pz_closure.h\"\n#include \"pz_code.h\"\n#include \"pz_gc_util.h\"\n#include \"pz_interp.h\"\n#include \"pz_util.h\"\n\nnamespace pz {\n\ntemplate \nstatic void builtin_create(Library * library, const String name,\n unsigned (*func_make_instrs)(uint8_t * bytecode,\n T data),\n T data, GCCapability & gccap);\n\nstatic void builtin_create_c_code(Library * library, String name,\n pz_foreign_c_func c_func,\n GCCapability & gccap);\n\nstatic void builtin_create_c_code_alloc(Library * library, String name,\n pz_foreign_c_alloc_func c_func,\n GCCapability & gccap);\n\nstatic void builtin_create_c_code_special(Library * library, String name,\n pz_foreign_c_special_func c_func,\n GCCapability & gccap);\n\nstatic unsigned make_ccall_instr(uint8_t * bytecode, pz_foreign_c_func c_func);\n\nstatic unsigned make_ccall_alloc_instr(uint8_t * bytecode,\n pz_foreign_c_alloc_func c_func);\n\nstatic unsigned make_ccall_special_instr(uint8_t * bytecode,\n pz_foreign_c_special_func c_func);\n\nstatic unsigned builtin_make_tag_instrs(uint8_t * bytecode, std::nullptr_t data)\n{\n unsigned offset = 0;\n\n /*\n * Take a word and a primary tag and combine them, this is pretty\n * simple.\n *\n * ptr tag - tagged_ptr\n */\n offset = write_instr(bytecode, offset, PZI_OR, PZW_PTR);\n offset = write_instr(bytecode, offset, PZI_RET);\n\n return offset;\n}\n\nstatic unsigned builtin_shift_make_tag_instrs(uint8_t * bytecode,\n std::nullptr_t data)\n{\n unsigned offset = 0;\n ImmediateValue imm = {.word = 0};\n\n /*\n * Take a word shift it left and combine it with a primary tag.\n *\n * word tag - tagged_word\n */\n imm.uint8 = 2;\n offset = write_instr(bytecode, offset, PZI_ROLL, IMT_8, imm);\n imm.uint8 = num_tag_bits;\n offset = write_instr(\n bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_8, imm);\n offset = write_instr(bytecode, offset, PZI_LSHIFT, PZW_PTR);\n offset = write_instr(bytecode, offset, PZI_OR, PZW_PTR);\n offset = write_instr(bytecode, offset, PZI_RET);\n\n return offset;\n}\n\nstatic unsigned builtin_break_tag_instrs(uint8_t * bytecode,\n std::nullptr_t data)\n{\n unsigned offset = 0;\n ImmediateValue imm = {.word = 0};\n\n /*\n * Take a tagged pointer and break it into the original pointer and tag.\n *\n * tagged_ptr - ptr tag\n */\n imm.uint8 = 1;\n offset = write_instr(bytecode, offset, PZI_PICK, IMT_8, imm);\n\n // Make pointer\n imm.uint32 = ~0 ^ tag_bits;\n offset = write_instr(\n bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_32, IMT_32, imm);\n if (WORDSIZE_BYTES == 8) {\n offset = write_instr(bytecode, offset, PZI_SE, PZW_32, PZW_64);\n }\n offset = write_instr(bytecode, offset, PZI_AND, PZW_PTR);\n\n imm.uint8 = 2;\n offset = write_instr(bytecode, offset, PZI_ROLL, IMT_8, imm);\n\n // Make tag.\n imm.uint32 = tag_bits;\n offset = write_instr(\n bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_32, imm);\n offset = write_instr(bytecode, offset, PZI_AND, PZW_PTR);\n\n offset = write_instr(bytecode, offset, PZI_RET);\n\n return offset;\n}\n\nstatic unsigned builtin_break_shift_tag_instrs(uint8_t * bytecode,\n std::nullptr_t data)\n{\n unsigned offset = 0;\n ImmediateValue imm = {.word = 0};\n\n /*\n * Take a tagged word and break it into the original word which is\n * shifted to the right and tag.\n *\n * tagged_word - word tag\n */\n imm.uint8 = 1;\n offset = write_instr(bytecode, offset, PZI_PICK, IMT_8, imm);\n\n // Make word\n imm.uint32 = ~0 ^ tag_bits;\n offset = write_instr(\n bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_32, IMT_32, imm);\n if (WORDSIZE_BYTES == 8) {\n offset = write_instr(bytecode, offset, PZI_SE, PZW_32, PZW_64);\n }\n offset = write_instr(bytecode, offset, PZI_AND, PZW_PTR);\n imm.uint8 = num_tag_bits;\n offset = write_instr(\n bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_8, imm);\n offset = write_instr(bytecode, offset, PZI_RSHIFT, PZW_PTR);\n\n imm.uint8 = 2;\n offset = write_instr(bytecode, offset, PZI_ROLL, IMT_8, imm);\n\n // Make tag.\n imm.uint32 = tag_bits;\n offset = write_instr(\n bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_32, imm);\n offset = write_instr(bytecode, offset, PZI_AND, PZW_PTR);\n\n offset = write_instr(bytecode, offset, PZI_RET);\n\n return offset;\n}\n\nstatic unsigned builtin_unshift_value_instrs(uint8_t * bytecode,\n std::nullptr_t data)\n{\n unsigned offset = 0;\n ImmediateValue imm = {.word = 0};\n\n /*\n * Take a word and shift it to the right to remove the tag.\n *\n * word - word\n */\n\n imm.uint8 = num_tag_bits;\n offset = write_instr(\n bytecode, offset, PZI_LOAD_IMMEDIATE_NUM, PZW_PTR, IMT_8, imm);\n offset = write_instr(bytecode, offset, PZI_RSHIFT, PZW_PTR);\n\n offset = write_instr(bytecode, offset, PZI_RET);\n\n return offset;\n}\n\nvoid setup_builtins(Library * library, GCCapability & gccap)\n{\n // clang-format off\n builtin_create_c_code(library, String(\"print\"),\n pz_builtin_print_func, gccap);\n builtin_create_c_code_alloc(library, String(\"readline\"),\n pz_builtin_readline_func, gccap);\n builtin_create_c_code_alloc(library, String(\"int_to_string\"),\n pz_builtin_int_to_string_func, gccap);\n builtin_create_c_code(library, String(\"setenv\"),\n pz_builtin_setenv_func, gccap);\n builtin_create_c_code(library, String(\"gettimeofday\"),\n pz_builtin_gettimeofday_func, gccap);\n builtin_create_c_code_alloc(library, String(\"string_concat\"),\n pz_builtin_string_concat_func, gccap);\n builtin_create_c_code(library, String(\"die\"),\n pz_builtin_die_func, gccap);\n builtin_create_c_code_special(library, String(\"set_parameter\"),\n pz_builtin_set_parameter_func, gccap);\n builtin_create_c_code_special(library, String(\"get_parameter\"),\n pz_builtin_get_parameter_func, gccap);\n builtin_create_c_code(library, String(\"codepoint_category\"),\n pz_builtin_codepoint_category, gccap);\n builtin_create_c_code_alloc(library, String(\"codepoint_to_string\"),\n pz_builtin_codepoint_to_string, gccap);\n builtin_create_c_code_alloc(library, String(\"strpos_forward\"),\n pz_builtin_strpos_forward, gccap);\n builtin_create_c_code_alloc(library, String(\"strpos_backward\"),\n pz_builtin_strpos_backward, gccap);\n builtin_create_c_code_alloc(library, String(\"strpos_next\"),\n pz_builtin_strpos_next_char, gccap);\n builtin_create_c_code_alloc(library, String(\"strpos_prev\"),\n pz_builtin_strpos_prev_char, gccap);\n builtin_create_c_code_alloc(library, String(\"string_begin\"),\n pz_builtin_string_begin, gccap);\n builtin_create_c_code_alloc(library, String(\"string_end\"),\n pz_builtin_string_end, gccap);\n builtin_create_c_code_alloc(library, String(\"string_substring\"),\n pz_builtin_string_substring, gccap);\n builtin_create_c_code(library, String(\"string_equals\"),\n pz_builtin_string_equals, gccap);\n\n builtin_create(library, String(\"make_tag\"),\n builtin_make_tag_instrs, nullptr, gccap);\n builtin_create(library, String(\"shift_make_tag\"),\n builtin_shift_make_tag_instrs, nullptr, gccap);\n builtin_create(library, String(\"break_tag\"),\n builtin_break_tag_instrs, nullptr, gccap);\n builtin_create(library, String(\"break_shift_tag\"),\n builtin_break_shift_tag_instrs, nullptr, gccap);\n builtin_create(library, String(\"unshift_value\"),\n builtin_unshift_value_instrs, nullptr, gccap);\n // clang-format on\n}\n\ntemplate \nstatic void builtin_create(Library * library, const String name,\n unsigned (*func_make_instrs)(uint8_t * bytecode,\n T data),\n T data, GCCapability & gccap)\n{\n // We forbid GC in this scope until the proc's code and closure are\n // reachable from module. We will check for OOM before using any\n // allocation results and abort if we're OOM.\n GCTracer gc(gccap);\n\n // If the proc code area cannot be allocated this is GC safe because it\n // will trace the closure. It would not work the other way around (we'd\n // have to make it faliable).\n unsigned size = func_make_instrs(nullptr, nullptr);\n Root proc(gc);\n {\n NoGCScope nogc(gc);\n proc = new (nogc) Proc(nogc, name, true, size);\n nogc.abort_if_oom(\"setting up builtins\");\n }\n func_make_instrs(proc->code(), data);\n\n Root closure(gc, new (gc) Closure(proc->code(), nullptr));\n\n RootString full_name(gc, String::append(gc, String(\"Builtin.\"), name));\n library->add_symbol(full_name, closure.ptr());\n}\n\nstatic void builtin_create_c_code(Library * library, String name,\n pz_foreign_c_func c_func,\n GCCapability & gccap)\n{\n builtin_create(\n library, name, make_ccall_instr, c_func, gccap);\n}\n\nstatic void builtin_create_c_code_alloc(Library * library, String name,\n pz_foreign_c_alloc_func c_func,\n GCCapability & gccap)\n{\n builtin_create(\n library, name, make_ccall_alloc_instr, c_func, gccap);\n}\n\nstatic void builtin_create_c_code_special(Library * library, String name,\n pz_foreign_c_special_func c_func,\n GCCapability & gccap)\n{\n builtin_create(\n library, name, make_ccall_special_instr, c_func, gccap);\n}\n\nstatic unsigned make_ccall_instr(uint8_t * bytecode, pz_foreign_c_func c_func)\n{\n ImmediateValue immediate_value;\n unsigned offset = 0;\n\n immediate_value.word = (uintptr_t)c_func;\n offset +=\n write_instr(bytecode, offset, PZI_CCALL, IMT_PROC_REF, immediate_value);\n offset += write_instr(bytecode, offset, PZI_RET);\n\n return offset;\n}\n\nstatic unsigned make_ccall_alloc_instr(uint8_t * bytecode,\n pz_foreign_c_alloc_func c_func)\n{\n ImmediateValue immediate_value;\n unsigned offset = 0;\n\n immediate_value.word = (uintptr_t)c_func;\n offset += write_instr(\n bytecode, offset, PZI_CCALL_ALLOC, IMT_PROC_REF, immediate_value);\n offset += write_instr(bytecode, offset, PZI_RET);\n\n return offset;\n}\n\nstatic unsigned make_ccall_special_instr(uint8_t * bytecode,\n pz_foreign_c_special_func c_func)\n{\n ImmediateValue immediate_value;\n unsigned offset = 0;\n\n immediate_value.word = (uintptr_t)c_func;\n offset += write_instr(\n bytecode, offset, PZI_CCALL_SPECIAL, IMT_PROC_REF, immediate_value);\n offset += write_instr(bytecode, offset, PZI_RET);\n\n return offset;\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_builtin.h", "content": "/*\n * Plasma builtins\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_BUILTIN_H\n#define PZ_BUILTIN_H\n\n#include \"pz.h\"\n#include \"pz_gc.h\"\n\nnamespace pz {\n\nvoid setup_builtins(Library * library, GCCapability & gccap);\n\n}\n\n#endif /* ! PZ_BUILTIN_H */\n" }, { "path": "runtime/pz_closure.h", "content": "/*\n * Plasma bytecode code structures and functions\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_CLOSURE_H\n#define PZ_CLOSURE_H\n\n// Redirect to the closure code for the generic interpreter. This would\n// have to be changed/preprocessed when we add other interpreter types.\n#include \"pz_generic_closure.h\"\n\n#endif // ! PZ_CLOSURE_H\n" }, { "path": "runtime/pz_code.cpp", "content": "/*\n * Plasma bytecode code structures and functions\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \"pz_code.h\"\n#include \"pz_gc.h\"\n\nnamespace pz {\n\nProc::Proc(NoGCScope & gc_cap, String name, bool is_builtin,\n unsigned size)\n : m_code_size(size)\n , m_name(name)\n , m_is_builtin(is_builtin)\n , m_contexts(gc_cap, 0)\n{\n m_code = (uint8_t *)gc_cap.alloc_bytes(size, META);\n heap_set_meta_info(&gc_cap.heap(), code(), this);\n}\n\nvoid Proc::add_context(GCCapability & gc_cap, unsigned offset,\n String filename, unsigned line)\n{\n if (m_filename.hasValue()) {\n assert(m_filename.value().equals(filename));\n } else {\n m_filename.set(filename);\n }\n\n set_context(gc_cap, offset, line);\n}\n\nvoid Proc::add_context(GCCapability & gc_cap, unsigned offset, unsigned line)\n{\n assert(m_filename.hasValue());\n set_context(gc_cap, offset, line);\n}\n\nvoid Proc::no_context(GCCapability & gc_cap, unsigned offset)\n{\n set_context(gc_cap, offset, 0);\n}\n\nvoid Proc::set_context(GCCapability & gc_cap, unsigned offset, unsigned value)\n{\n bool res = m_contexts.append(gc_cap, OffsetContext(offset, value));\n\n // We expect the return code to be true unless GCCapability is a\n // NoGCScope, and it probably isn't.\n if (!res) {\n assert(res);\n }\n // Check that this isn't a NoGCScope so we know to fix the above\n // assumption if that changes.\n assert(gc_cap.can_gc());\n}\n\nunsigned Proc::line(unsigned offset, unsigned * last_lookup) const\n{\n unsigned start;\n if (*last_lookup == 0 || m_contexts[*last_lookup - 1].offset > offset) {\n start = 0;\n } else {\n start = *last_lookup - 1;\n }\n\n /*\n * The loop condition is such that i and i+1 are both within the bounds\n * of m_contexts.\n */\n for (unsigned i = start; i + 1 < m_contexts.size(); i++) {\n // If the current offset is between this and the next.\n if ((m_contexts[i].offset <= offset) &&\n (m_contexts[i+1].offset > offset))\n {\n *last_lookup = i;\n return m_contexts[i].line;\n }\n }\n if (m_contexts.size() > 0 && m_contexts.back().offset <= offset) {\n *last_lookup = m_contexts.size() - 1;\n return m_contexts.back().line;\n }\n\n return 0;\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_code.h", "content": "/*\n * Plasma bytecode code structures and functions\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_CODE_H\n#define PZ_CODE_H\n\n#include \"pz_cxx_future.h\"\n#include \"pz_gc_util.h\"\n#include \"pz_string.h\"\n#include \"pz_vector.h\"\n\nnamespace pz {\n\nstruct OffsetContext {\n OffsetContext() : offset(0), line(0) {}\n OffsetContext(unsigned offset_, unsigned line_)\n : offset(offset_)\n , line(line_)\n {}\n\n unsigned offset;\n unsigned line;\n};\n\n/*\n * Code layout in memory\n *\n *************************/\nclass Proc : public GCNew\n{\n private:\n uint8_t *m_code;\n unsigned m_code_size;\n String m_name;\n\n bool m_is_builtin;\n Optional m_filename;\n Vector m_contexts;\n\n public:\n Proc(NoGCScope & gc_cap, const String name, bool is_builtin,\n unsigned size);\n\n void set_name(String name)\n {\n m_name = name;\n }\n String name() const\n {\n return m_name;\n }\n\n uint8_t * code() const\n {\n return m_code;\n }\n unsigned size() const\n {\n return m_code_size;\n }\n\n bool is_builtin() const\n {\n return m_is_builtin;\n }\n\n Proc() = delete;\n Proc(const Proc &) = delete;\n void operator=(const Proc & other) = delete;\n\n // Add context information for this and the following code offsets.\n void add_context(GCCapability & gc_cap, unsigned offset,\n String filename, unsigned line);\n void add_context(GCCapability & gc_cap, unsigned offset, unsigned line);\n // This and the following code offsets have no context infomation.\n void no_context(GCCapability & gc_cap, unsigned offset);\n\n Optional filename() const\n {\n return m_filename;\n }\n unsigned line(unsigned offset, unsigned * last_lookup) const;\n\n private:\n void set_context(GCCapability & gc_cap, unsigned offset, unsigned value);\n};\n\n} // namespace pz\n\n#endif /* ! PZ_CODE_H */\n" }, { "path": "runtime/pz_common.h", "content": "/*\n * Plasma bytecode comon includes\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_COMMON_H\n#define PZ_COMMON_H\n\n#include \"pz_config.h\"\n\n#include \n#include \n#include \n#include \n#include \n\n#endif /* ! PZ_COMMON_H */\n" }, { "path": "runtime/pz_config.h.in", "content": "/*\n * Plasma bytecode execution configuration.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) 2015, 2021 Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_CONFIG_H\n#define PZ_CONFIG_H\n\n#define PLASMA_VERSION @VERSION@\n#if PLASMA_VERSION == dev\n#define PLASMA_VERSION_STRING \"development version\"\n#else\n#define PLASMA_VERSION_STRING \"@VERSION@\"\n#endif\n\n/*\n * Either 32 or 64 bit\n */\n#define PZ_FAST_INTEGER_WIDTH 32\n#define PZ_FAST_INTEGER_TYPE int32_t\n#define PZ_FAST_UINTEGER_TYPE uint32_t\n\n/*\n * Debugging\n */\n#ifdef DEBUG\n#else\n#define NDEBUG\n#endif\n\n/*\n * Runtime error exit codes\n */\n// Fatal errors, the program didn't run or was aborted.\n#define PZ_EXIT_RUNTIME_ERROR 255\n// Non-fatal, the program terminated but there was a warning or error during\n// clean-up.\n#define PZ_EXIT_RUNTIME_NONFATAL 254\n\n#endif /* ! PZ_CONFIG_H */\n" }, { "path": "runtime/pz_cxx_future.h", "content": "/*\n * PZ C++ future library functions.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n *\n * This file contains library code that has been added to a more recent C++\n * version than the one we've standardised on (C++11) or features that we\n * might reasonably expect to be added to a future version. If/when we move\n * to a newer standard we can delete entries here and update code as\n * necessary.\n */\n\n#ifndef PZ_CXX_FUTURE_H\n#define PZ_CXX_FUTURE_H\n\n#include \n#include \n\n/*\n * C++17 libraries don't seem to be on my dev system,\n * other people might also be missing them. So just implement this\n * ourselves.\n */\ntemplate \nclass Optional\n{\n private:\n bool m_present = false;\n\n /*\n * AlaskanEmily suggested this trick, allocate space for T here and use\n * placement new below so that T's without default constructors can be\n * used.\n */\n static_assert(sizeof(T) >= 1, \"T must have non-zero size\");\n alignas(alignof(T)) char m_data[sizeof(T)] = {0};\n\n public:\n constexpr Optional() {}\n\n // Implicit constructor\n Optional(const T & val) {\n set(val);\n }\n\n Optional(T && val) : m_present(true) {\n value() = std::move(val);\n }\n\n Optional(const Optional & other) {\n if (other.hasValue()) {\n set(other.value());\n }\n }\n\n Optional(Optional && other) {\n if (other.hasValue()) {\n set(other.release());\n }\n }\n\n ~Optional() {\n clear();\n }\n\n Optional & operator=(const Optional & other) {\n if (this != &other) {\n if (other.hasValue()) {\n set(other.value());\n } else {\n clear();\n }\n }\n\n return *this;\n }\n\n Optional & operator=(Optional && other) {\n if (this != &other) { \n if (other.hasValue()) {\n set(other.release());\n } else {\n clear();\n }\n }\n\n return *this;\n }\n\n static constexpr Optional Nothing() {\n return Optional();\n }\n\n bool hasValue() const {\n return m_present;\n }\n\n void set(const T & val) {\n clear();\n new (m_data) T(val);\n m_present = true;\n }\n\n void set(T && val) {\n clear();\n new (m_data) T(std::move(val));\n m_present = true;\n }\n\n T & value() {\n assert(m_present);\n return raw();\n }\n\n const T & value() const {\n assert(m_present);\n return raw();\n }\n\n T && release() {\n assert(m_present);\n m_present = false;\n return std::move(raw());\n }\n\n void clear() {\n if (m_present) {\n raw().~T();\n }\n m_present = false;\n }\n\n private:\n // Access the storage as the correct type without an assertion.\n T & raw() {\n return reinterpret_cast(m_data);\n }\n const T & raw() const {\n return reinterpret_cast(m_data);\n }\n};\n\nclass ScopeExit\n{\n public:\n explicit ScopeExit(std::function && f) : m_f(f) {}\n ~ScopeExit()\n {\n m_f();\n }\n\n private:\n std::function m_f;\n};\n\n#endif // ! PZ_CXX_FUTURE_H\n" }, { "path": "runtime/pz_data.cpp", "content": "/*\n * Plasma bytecode data and types loading and runtime\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \n#include \n\n#include \"pz_common.h\"\n\n#include \"pz_data.h\"\n#include \"pz_util.h\"\n\n/*\n * Structs\n *\n **********/\n\nnamespace pz {\n\nvoid Struct::calculate_layout()\n{\n#ifdef PZ_DEV\n assert(!m_layout_calculated);\n m_layout_calculated = true;\n#endif\n unsigned size = 0;\n\n for (unsigned i = 0; i < num_fields(); i++) {\n unsigned field_size = width_to_bytes(m_fields[i].width);\n\n size = AlignUp(size, field_size);\n m_fields[i].offset = size;\n size += field_size;\n }\n m_total_size = size;\n}\n\n/*\n * Data\n *\n **********/\n\nvoid * data_new_array_data(GCCapability & gc_tracer, PZ_Width width,\n uint32_t num_elements)\n{\n return gc_tracer.alloc_bytes(width_to_bytes(width) * num_elements);\n}\n\nvoid * data_new_struct_data(GCCapability & gc_tracer, size_t size)\n{\n // TODO: Use this during execution of PZT_ALLOC.\n return gc_tracer.alloc_bytes(size);\n}\n\n/*\n * Functions for storing data in memory\n ***************************************/\n\nvoid data_write_normal_uint8(void * dest, uint8_t value)\n{\n *((uint8_t *)dest) = value;\n}\n\nvoid data_write_normal_uint16(void * dest, uint16_t value)\n{\n *((uint16_t *)dest) = value;\n}\n\nvoid data_write_normal_uint32(void * dest, uint32_t value)\n{\n *((uint32_t *)dest) = value;\n}\n\nvoid data_write_normal_uint64(void * dest, uint64_t value)\n{\n *((uint64_t *)dest) = value;\n}\n\nvoid data_write_fast_from_int32(void * dest, int32_t value)\n{\n *((PZ_FAST_INTEGER_TYPE *)dest) = (PZ_FAST_INTEGER_TYPE)value;\n}\n\nvoid data_write_wptr(void * dest, intptr_t value)\n{\n *((intptr_t *)dest) = value;\n}\n\nOptional width_from_int(uint8_t w)\n{\n switch (w) {\n case PZW_8:\n return PZW_8;\n case PZW_16:\n return PZW_16;\n case PZW_32:\n return PZW_32;\n case PZW_64:\n return PZW_64;\n case PZW_FAST:\n return PZW_FAST;\n case PZW_PTR:\n return PZW_PTR;\n default:\n return Optional::Nothing();\n }\n}\n\nPZ_Width width_normalize(PZ_Width width)\n{\n switch (width) {\n case PZW_FAST:\n switch (PZ_FAST_INTEGER_WIDTH) {\n case 32:\n return PZW_32;\n case 64:\n return PZW_64;\n default:\n fprintf(stderr,\n \"PZ_FAST_INTEGER_WIDTH has unanticipated value\\n\");\n abort();\n }\n break;\n case PZW_PTR:\n switch (sizeof(intptr_t)) {\n case 4:\n return PZW_32;\n case 8:\n return PZW_64;\n default:\n fprintf(stderr, \"Unknown pointer width\\n\");\n abort();\n }\n break;\n default:\n return width;\n }\n}\n\nunsigned width_to_bytes(PZ_Width width)\n{\n width = width_normalize(width);\n switch (width) {\n case PZW_8:\n return 1;\n case PZW_16:\n return 2;\n case PZW_32:\n return 4;\n case PZW_64:\n return 8;\n default:\n fprintf(stderr, \"Width should have been normalized\");\n abort();\n }\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_data.h", "content": "/*\n * Plasma bytecode data and types loading and runtime\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_DATA_H\n#define PZ_DATA_H\n\n#include \n\n#include \"pz_cxx_future.h\"\n#include \"pz_format.h\"\n#include \"pz_gc_util.h\"\n\nnamespace pz {\n\nstruct Struct_Field : public GCNew {\n private:\n PZ_Width width;\n uint16_t offset;\n\n Struct_Field(){};\n explicit Struct_Field(PZ_Width w) : width(w) {}\n\n friend class Struct;\n};\n\nclass Struct : public GCNew\n{\n private:\n // TODO Create an array class that wraps C arrays, performs bounds\n // checking and is GC allocatable.\n Struct_Field * m_fields;\n unsigned m_num_fields;\n unsigned m_total_size;\n#ifdef PZ_DEV\n bool m_layout_calculated;\n#endif\n\n public:\n Struct() = delete;\n explicit Struct(NoGCScope & gc_cap, unsigned num_fields)\n : m_num_fields(num_fields)\n#ifdef PZ_DEV\n , m_layout_calculated(false)\n#endif\n {\n m_fields = new (gc_cap) Struct_Field[num_fields];\n }\n\n unsigned num_fields() const\n {\n return m_num_fields;\n }\n unsigned total_size() const\n {\n return m_total_size;\n }\n\n uint16_t field_offset(unsigned num) const\n {\n#ifdef PZ_DEV\n assert(m_layout_calculated);\n#endif\n assert(num < m_num_fields);\n return m_fields[num].offset;\n }\n\n void set_field(unsigned i, PZ_Width width)\n {\n m_fields[i] = Struct_Field(width);\n }\n\n void calculate_layout();\n\n Struct(const Struct &) = delete;\n void operator=(const Struct & other) = delete;\n};\n\nOptional width_from_int(uint8_t w);\n\nPZ_Width width_normalize(PZ_Width w);\n\nunsigned width_to_bytes(PZ_Width w);\n\n/*\n * Data\n *\n *******/\n\n/*\n * Allocate space for array data. If the width is 0 then the array contains\n * references to other data, and each element should be machine word sized.\n */\nvoid * data_new_array_data(GCCapability & gc_tracer, PZ_Width width,\n uint32_t num_elements);\n\n/*\n * Allocate space for struct data.\n */\nvoid * data_new_struct_data(GCCapability & gc_tracer, size_t size);\n\n/*\n * Functions for storing data in memory\n ***************************************/\n\n/*\n * Write the given value into the data object.\n */\nvoid data_write_normal_uint8(void * dest, uint8_t value);\nvoid data_write_normal_uint16(void * dest, uint16_t value);\nvoid data_write_normal_uint32(void * dest, uint32_t value);\nvoid data_write_normal_uint64(void * dest, uint64_t value);\n\n/*\n * Write the given value into the data object. The value will be sign\n * extended to the \"fast\" width.\n */\nvoid data_write_fast_from_int32(void * dest, int32_t value);\n\nvoid data_write_wptr(void * dest, intptr_t value);\n\n} // namespace pz\n\n#endif /* ! PZ_DATA_H */\n" }, { "path": "runtime/pz_foreign.cpp", "content": "/*\n * Plasma foreign code linker\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n#include \n#include \n#include \n#include \n#include \n#include \n\n#include \"pz_cxx_future.h\"\n#include \"pz_string.h\"\n#include \"pz_gc_util.h\"\n\n#include \"pz_foreign.h\"\n\n#define PZ_INIT_FOREIGN_CODE \"pz_init_foreign_code\"\n\nnamespace pz {\n\nForeign::Foreign(void * handle, foreign_library_cxx_function init_fn)\n : m_handle(handle)\n , m_init_fn(init_fn)\n{}\n\n\nstatic std::string safe_getcwd() {\n size_t len = 64;\n std::unique_ptr buffer(new char[len]);\n char * result = getcwd(buffer.get(), len);\n\n // Try again with a larger buffer\n while (!result && errno == ERANGE) {\n len *= 2;\n buffer = std::unique_ptr(new char[len]);\n result = getcwd(buffer.get(), len);\n }\n\n if (!result) {\n perror(\"getcwd()\");\n exit(1);\n }\n\n return std::string(result);\n}\n\nForeign::~Foreign() {\n if (m_handle) {\n dlclose(m_handle);\n }\n}\n\n// static\nbool\nForeign::maybe_load(const std::string & filename, GCTracer &gc,\n Root &foreign)\n{\n // Check that the library file exists, we need to do this ourselves\n // because dlload won't tell us.\n struct stat statbuf;\n if (-1 == stat(filename.c_str(), &statbuf)) {\n if (errno == ENOENT) {\n // The file doesn't exist\n return false;\n }\n // Some other error,\n perror(filename.c_str());\n }\n\n // The file probably exists, construct a path.\n std::string path;\n if (filename.length() > 0 && filename[0] == '/') {\n path = filename;\n } else {\n path = safe_getcwd() + \"/\" + filename;\n }\n\n // XXX: Use lazy resolution in release builds.\n void * handle = dlopen(path.c_str(), RTLD_NOW | RTLD_LOCAL);\n if (!handle) {\n fprintf(stderr, \"%s\\n\", dlerror());\n return false;\n }\n\n dlerror(); // Clear the error state.\n foreign_library_cxx_function init_fn =\n reinterpret_cast(\n dlsym(handle, PZ_INIT_FOREIGN_CODE));\n if (!init_fn) {\n const char * error = dlerror();\n if (error) {\n fprintf(stderr, \"%s\\n\", error);\n } else {\n fprintf(stderr, \"%s: Initial function is null\\n\",\n filename.c_str());\n }\n return false;\n }\n\n foreign = new(gc) Foreign(handle, init_fn);\n return true;\n}\n\nbool\nForeign::init(GCTracer & gc) {\n assert(m_init_fn);\n return m_init_fn(this, &gc);\n}\n\nClosure *\nForeign::lookup_foreign_proc(String module_name, String closure_name) const {\n auto module = m_closures.find(module_name);\n if (module == m_closures.end()) {\n return nullptr;\n }\n auto closure = module->second.find(closure_name);\n if (closure == module->second.end()) {\n return nullptr;\n }\n return closure->second;\n}\n\nstatic unsigned make_ccall_instr(uint8_t * bytecode, pz_foreign_c_func c_func)\n{\n ImmediateValue immediate_value;\n unsigned offset = 0;\n\n immediate_value.word = (uintptr_t)c_func;\n offset +=\n write_instr(bytecode, offset, PZI_CCALL, IMT_PROC_REF, immediate_value);\n offset += write_instr(bytecode, offset, PZI_RET);\n\n return offset;\n}\n\nstatic void make_foreign(String name, pz_foreign_c_func c_func, GCTracer & gc,\n Foreign *foreign, Root &closure)\n{\n unsigned size = make_ccall_instr(nullptr, nullptr);\n\n Root proc(gc);\n {\n NoGCScope nogc(gc);\n proc = new (nogc) Proc(nogc, name, true, size);\n nogc.abort_if_oom(\"setting up foreign code\");\n }\n make_ccall_instr(proc->code(), c_func);\n\n // Use foreign as the closure's unused data pointer to ensure that the\n // Foreign object is referenced while closures may still point to its\n // code.\n closure = new (gc) Closure(proc->code(), foreign);\n}\n\nvoid\nForeign::do_trace(HeapMarkState * marker) const {\n for (auto m : m_closures) {\n marker->mark_root(m.first.ptr());\n for (auto c : m.second) {\n marker->mark_root(c.first.ptr());\n marker->mark_root(c.second);\n }\n }\n}\n\nbool\nForeign::register_foreign_code(String module, String proc,\n pz_foreign_c_func c_func, GCTracer & gc)\n{\n Root closure(gc);\n make_foreign(proc, c_func, gc, this, closure);\n\n m_closures[module][proc] = closure.ptr();\n\n return true;\n}\n\n} // namespace pz\n\n" }, { "path": "runtime/pz_foreign.h", "content": "/*\n * Plasma foreign code linker\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_FOREIGN_H\n#define PZ_FOREIGN_H\n\n#include \n\n#include \"pz_cxx_future.h\"\n#include \"pz_interp.h\"\n\nnamespace pz {\n\nclass Foreign;\n\ntypedef bool (*foreign_library_cxx_function)(Foreign * foreign, GCTracer * gc);\n\nclass Foreign : public GCNewTrace {\n private:\n void * m_handle;\n foreign_library_cxx_function m_init_fn;\n std::unordered_map>\n m_closures =\n std::unordered_map>(1);\n\n Foreign(void * handle, foreign_library_cxx_function init_fn);\n\n public:\n ~Foreign();\n\n static bool maybe_load(const std::string & filename, GCTracer &gc,\n Root &foreign);\n bool init(GCTracer & gc);\n\n // Not copyable since it has unique resource ownership.\n Foreign(const Foreign &) = delete;\n Foreign(Foreign && other) = delete;\n const Foreign & operator=(const Foreign &) = delete;\n const Foreign & operator=(Foreign && other) = delete;\n\n Closure * lookup_foreign_proc(String module, String proc) const;\n\n void do_trace(HeapMarkState * marker) const override;\n\n /*\n * These functions help setup foreign code.\n */\n bool register_foreign_code(String module, String proc, \n pz_foreign_c_func c_func, GCTracer & gc);\n};\n\n} // namespace pz\n\n#endif /* ! PZ_FOREIGN_H */\n" }, { "path": "runtime/pz_format.h", "content": "/*\n * Plasma bytecode format constants\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n *\n * This file is used by both the tools in runtime/ and src/\n */\n\n#ifndef PZ_FORMAT_H\n#define PZ_FORMAT_H\n\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n/*\n * The PZ format is a binary format. No padding is used and all numbers are\n * unsigned integers in little-endian format unless otherwise specified.\n */\n\n/*\n * PZ Syntax description\n * =====================\n *\n * The PZ file begins with a magic number, a description string whose prefix\n * is given below (suffix & length don't matter allowing an ascii version\n * number to be provided), a 16 bit version number, an options entry then\n * the file's entries.\n *\n * PZ ::= Magic(32bit) DescString VersionNumber(16bit) Options\n * NumNames(32bit) ModuleName(String)*\n * NumImports(32bit) NumStructs(32bit) NumDatas(32bit)\n * NumProcs(32bit) NumClosures(32bit) NumExports(32bit)\n * ImportRef* StructEntry* DataEntry* ProcEntry*\n * ClosureEntry* ExportRef*\n *\n * Options\n * -------\n *\n * All option entries begin with a 16 bit type and a 16 bit length. The\n * length gives the length of the value and the type says how to interpret\n * it.\n *\n * Options ::= NumOptions(16bit) OptionEntry*\n *\n * OptionEntry ::= OptionType(16bit) Len(16bit) OptionValue\n *\n * Procedure and data entries are each given a unique 32bit procedure or\n * data ID. To clarify, procedures and data entries exist in seperate ID\n * spaces. The IDs start at 0 for the first entry and are given\n * sequentially in file order. IDs are used for example in the call\n * instruction which must specify the callee.\n *\n * Imports & Exports\n * -----------------\n *\n * Import refs map IDs onto closure names to be provided by other modules.\n * Imported closures are identified by a high 31st bit.\n *\n * Import names are split into module and symbol parts so that the check\n * for the module and the check for whether the module contains the symbol\n * are easily seperated as they can produce different errors.\n *\n * ImportRef ::= ImportType(8bit) ModuleName(String) SymbolName(String)\n *\n * Export refs map fully qualified names onto closure Ids. All the symbols\n * listed are exported.\n *\n * ExportRef ::= SymbolName(String) ClosureId(32Bit)\n *\n * Struct information\n * ------------------\n *\n * StructEntry ::= NumFields(32bit) Width*\n *\n * Constant data\n * -------------\n *\n * A data entry is a data type followed by the data (numbers and\n * references). The number and in-memory widths of each number are given\n * by the data type. The on disk widths/encodings are given in each value.\n *\n * Data references may not form cycles, and the referred-to data items must\n * occur before the referred-from items.\n *\n * DataEntry ::= DATA_ARRAY(8) NumElements(16) Width DataEnc DataValue*\n * | DATA_STRUCT(8) StructRef DataEncValue*\n * | DATA_STRING(8) NumElements(16) DataEnc DataValue*\n *\n * Note that an array of structs is acheived by an array o pointers to\n * pre-defined structs. (TODO: it'd be nice to support other data layouts\n * like an array of structs.)\n *\n * Which data value depends upon context.\n *\n * DataEncValue ::= DataEnc DataValue\n *\n * DataEnc ::= ENC_NORMAL NumBytes\n * | ENC_FAST 4\n * | ENC_WPTR 4\n * | ENC_DATA 4\n * | ENC_IMPORT 4\n * | ENC_CLOSURE 4\n *\n * The encoding type and number of bytes are a single byte made up by\n * PZ_MAKE_ENC below. Currently fast words and pointer-sized words are\n * always 32bit.\n *\n * DataValue ::= Byte*\n * | DataIndex(32bit)\n * | ImportIndex(32bit)\n * | ClosureIndex(32bit)\n *\n * Code\n * ----\n *\n * ProcEntry ::= Name(String) NumBlocks(32bit) Block+\n * Block ::= NumInstrObjs(32bit) InstrObj+\n *\n * InstrObj ::= CODE_INSTR(8) Instruction\n * | MetaItem\n * Instruction ::= Opcode(8bit) WidthByte{0,2} Immediate?\n * InstructionStream?\n *\n * MetaItem ::= CODE_META_CONTEXT(8) FileName(DataIndex) LineNo(32bit)\n * | CODE_META_CONTEXT_SHORT(8) LineNo(32bit)\n * | CODE_META_CONTEXT_NIL(8)\n *\n * Closures\n * --------\n *\n * ClosureEntry ::= ProcId(32bit) DataId(32bit)\n *\n * Shared items\n * ------------\n *\n * Widths are a single byte defined by the Width enum. Note that a data\n * width (a width for data items) is a seperate thing, and encoded\n * differently. They may be:\n * PZW_8,\n * PZW_16,\n * PZW_32,\n * PZW_64,\n * PZW_FAST, efficient integer width\n * PZW_PTR, native pointer width\n *\n * Strings are encoded with a number of bytes giving the length followed by\n * the string's bytes.\n *\n * String ::= Length(16bit) Bytes*\n *\n */\n\n#define PZ_OBJECT_MAGIC_NUMBER 0x505A4F00 // PZ0\n#define PZ_PROGRAM_MAGIC_NUMBER 0x505A5000 // PZP\n#define PZ_LIBRARY_MAGIC_NUMBER 0x505A4C00 // PZL\n#define PZ_OBJECT_MAGIC_STRING \"Plasma object\"\n#define PZ_PROGRAM_MAGIC_STRING \"Plasma program\"\n#define PZ_LIBRARY_MAGIC_STRING \"Plasma library\"\n#define PZ_FORMAT_VERSION 0\n\n#define PZ_OPT_ENTRY_CLOSURE 0\n/*\n * Value:\n * 8bit number giving the signature of the entry closure.\n * 32bit number of the program's entry closure\n */\n#define PZ_OPT_ENTRY_CANDIDATE 1\n/*\n * Value:\n * 8bit number giving the signature of the entry closure.\n * 32bit number of the program's entry closure (must be an exported\n * closure).\n */\n\nenum PZOptEntrySignature {\n PZ_OPT_ENTRY_SIG_PLAIN,\n PZ_OPT_ENTRY_SIG_ARGS,\n PZ_OPT_ENTRY_SIG_LAST = PZ_OPT_ENTRY_SIG_ARGS\n};\n\nenum PZ_Import_Type {\n PZ_IMPORT_IMPORT,\n PZ_IMPORT_FOREIGN,\n PZ_IMPORT_LAST = PZ_IMPORT_FOREIGN\n};\n\n/*\n * The width of data, either as an operand or in memory such as in a struct.\n */\nenum PZ_Width {\n PZW_8,\n PZW_16,\n PZW_32,\n PZW_64,\n PZW_FAST, // efficient integer width\n PZW_PTR, // native pointer width\n};\n#define PZ_NUM_WIDTHS (PZW_PTR + 1)\n\n#define PZ_DATA_ARRAY 0\n#define PZ_DATA_STRUCT 1\n#define PZ_DATA_STRING 2\n\n/*\n * The high bits of a data width give the width type. Width types are:\n * - Pointers: 32-bit references to some other\n * value, updated on load.\n * - Words with pointer width: 32-bit values zero-extended to the width of\n * a pointer.\n * - Fast words: Must be encoded with 32bits.\n * - Normal: Encoded and in-memory width are the same.\n *\n * The low bits give the width for normal-width values. Other values are\n * always encoded as 32bit. (TODO: maybe this can be changed with a PZ file\n * option.)\n */\n#define PZ_DATA_ENC_TYPE_BITS 0xF0\n#define PZ_DATA_ENC_BYTES_BITS 0x0F\n#define PZ_DATA_ENC_TYPE(byte) \\\n (enum pz_data_enc_type)((byte)&PZ_DATA_ENC_TYPE_BITS)\n#define PZ_DATA_ENC_BYTES(byte) ((byte)&PZ_DATA_ENC_BYTES_BITS)\n#define PZ_MAKE_ENC(type, bytes) ((type) | (bytes))\n\nenum pz_data_enc_type {\n pz_data_enc_type_normal = 0x00,\n pz_data_enc_type_fast = 0x10,\n pz_data_enc_type_wptr = 0x20,\n pz_data_enc_type_data = 0x30,\n pz_data_enc_type_import = 0x40,\n pz_data_enc_type_closure = 0x50,\n};\n#define PZ_LAST_DATA_ENC_TYPE pz_data_enc_type_closure;\n\nenum PZ_Code_Item {\n PZ_CODE_INSTR,\n PZ_CODE_META_CONTEXT,\n PZ_CODE_META_CONTEXT_SHORT,\n PZ_CODE_META_CONTEXT_NIL,\n};\n#define PZ_NUM_CODE_ITEMS (PZ_CODE_META_CONTEXT_NIL + 1)\n\n#ifdef __cplusplus\n} // extern \"C\"\n#endif\n\n#endif /* ! PZ_FORMAT_H */\n" }, { "path": "runtime/pz_gc.cpp", "content": "/*\n * Plasma garbage collector\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n#include \n#include \n#include \n\n#include \"pz_util.h\"\n\n#include \"pz_gc.h\"\n#include \"pz_gc_util.h\"\n\n#include \"pz_gc.impl.h\"\n#include \"pz_gc_layout.h\"\n#include \"pz_gc_layout.impl.h\"\n\n/*\n * Plasma GC\n * ---------\n *\n * We want a GC that provides enough features to meet some MVP-ish goals. It\n * only needs to be good enough to ensure we recover memory. It is\n * currently a little bit better than that.\n *\n * * Mark/Sweep\n * * Non-moving\n * * Conservative\n * * Interior pointers (up to 7 byte offset)\n * * Block based, each block contains cells of a particular size, a marking\n * bitmap and free list pointer (the free list is made of unused cell\n * contents.\n * * Blocks are allocated from Chunks. We allocate chunks from the OS.\n *\n * This GC is fairly simple. There are a few changes we could make to\n * improve it in the medium term:\n *\n * https://github.com/PlasmaLang/plasma/labels/component%3A%20gc\n *\n * In the slightly longer term we should:\n *\n * * Use accurate pointer information and test it by adding compaction.\n *\n * In the long term, and with much tweaking, this GC will become the\n * tenured and maybe the tenured/mutable part of a larger GC with more\n * features and improvements.\n */\n\nnamespace pz {\n\n/***************************************************************************\n *\n * These procedures will likely move somewhere else, but maybe after some\n * refactoring.\n */\n\nsize_t heap_get_usage(const Heap * heap)\n{\n return heap->usage();\n}\n\nunsigned heap_get_collections(const Heap * heap)\n{\n return heap->collections();\n}\n\nvoid heap_set_meta_info(Heap * heap, void * obj, void * meta)\n{\n heap->set_meta_info(obj, meta);\n}\n\nvoid * heap_interior_ptr_to_ptr(const Heap * heap, void * ptr)\n{\n return heap->interior_ptr_to_ptr(ptr);\n}\n\nvoid * Heap::interior_ptr_to_ptr(void * iptr) const\n{\n CellPtrBOP cellb = ptr_to_bop_cell_interior(iptr);\n if (cellb.is_valid()) {\n return cellb.pointer();\n } else {\n CellPtrFit cellf = ptr_to_fit_cell_interior(iptr);\n if (cellf.is_valid()) {\n return cellf.pointer();\n }\n }\n\n return nullptr;\n}\n\nvoid * heap_meta_info(const Heap * heap, void * obj)\n{\n return heap->meta_info(obj);\n}\n\nbool ChunkBOP::is_empty() const\n{\n for (unsigned i = 0; i < m_wilderness; i++) {\n if (m_blocks[i].is_in_use()) return false;\n }\n return true;\n}\n\nbool ChunkFit::is_empty()\n{\n CellPtrFit cell = first_cell();\n return !cell.is_allocated() &&\n cell.size() ==\n ((Payload_Bytes - CellPtrFit::CellInfoOffset) / WORDSIZE_BYTES);\n}\n\n/***************************************************************************/\n\nHeap::Heap(const Options & options)\n : m_options(options)\n , m_chunk_bop(\"GC BOP\")\n , m_chunk_fit(\"GC fit\")\n , m_threshold(GC_Initial_Threshold)\n{}\n\nHeap::~Heap()\n{\n assert(!m_chunk_bop.is_mapped());\n assert(!m_chunk_fit.is_mapped());\n}\n\nbool Heap::init()\n{\n assert(!m_chunk_bop.is_mapped());\n if (m_chunk_bop.allocate(GC_Chunk_Size)) {\n new (m_chunk_bop.ptr()) ChunkBOP(this);\n } else {\n return false;\n }\n\n assert(!m_chunk_fit.is_mapped());\n if (m_chunk_fit.allocate(GC_Chunk_Size)) {\n new (m_chunk_fit.ptr()) ChunkFit(this);\n } else {\n return false;\n }\n\n return true;\n}\n\nbool Heap::finalise(bool fast)\n{\n if (fast) {\n m_chunk_bop.forget();\n m_chunk_fit.forget();\n return true;\n }\n\n bool result = true;\n\n if (m_chunk_bop.is_mapped()) {\n if (!m_chunk_bop.release()) {\n result = false;\n }\n }\n\n if (m_chunk_fit.is_mapped()) {\n // sweeping first ensures we run finalisers.\n m_chunk_fit->sweep(m_options);\n if (!m_chunk_fit.release()) {\n result = false;\n }\n }\n\n return result;\n}\n\n/***************************************************************************/\n\nBlock::Block(const Options & options, size_t cell_size_) : m_header(cell_size_)\n{\n assert(cell_size_ >= GC_Min_Cell_Size);\n memset(m_header.bitmap, 0, GC_Cells_Per_Block * sizeof(uint8_t));\n\n#if PZ_DEV\n if (options.gc_poison()) {\n memset(m_bytes, Poison_Byte, Payload_Bytes);\n }\n#endif\n\n sweep(options);\n}\n\n/***************************************************************************/\n\nsize_t Block::usage()\n{\n return num_allocated() * size() * WORDSIZE_BYTES;\n}\n\nunsigned Block::num_allocated()\n{\n unsigned count = 0;\n\n for (unsigned i = 0; i < num_cells(); i++) {\n CellPtrBOP cell(this, i);\n if (cell.is_allocated()) {\n count++;\n }\n }\n\n return count;\n}\n\nsize_t ChunkBOP::usage()\n{\n size_t usage = 0;\n\n for (unsigned i = 0; i < m_wilderness; i++) {\n if (m_blocks[i].is_in_use()) {\n usage += m_blocks[i].usage();\n }\n }\n\n return usage;\n}\n\nsize_t ChunkFit::usage()\n{\n size_t size = 0;\n\n CellPtrFit cell = first_cell();\n while (cell.is_valid()) {\n if (cell.is_allocated()) {\n size += cell.size() * WORDSIZE_BYTES + CellPtrFit::CellInfoOffset;\n }\n cell = cell.next_in_chunk();\n }\n return size;\n}\n\n/***************************************************************************/\n\nvoid Heap::set_meta_info(void * obj, void * meta)\n{\n CellPtrFit cell = ptr_to_fit_cell(obj);\n assert(cell.is_valid());\n *cell.meta() = meta;\n}\n\nvoid * Heap::meta_info(void * obj) const\n{\n CellPtrFit cell = ptr_to_fit_cell(obj);\n assert(cell.is_valid());\n return *cell.meta();\n}\n\n} // namespace pz\n\n/***************************************************************************\n *\n * Check arhitecture assumptions\n */\n\n// 8 bits per byte\nstatic_assert(WORDSIZE_BYTES * 8 == WORDSIZE_BITS, \"8 bits in a byte\");\n\n// 32 or 64 bit.\nstatic_assert(WORDSIZE_BITS == 64 || WORDSIZE_BITS == 32,\n \"Either 32 or 64bit wordsize\");\n" }, { "path": "runtime/pz_gc.h", "content": "/*\n * Plasma garbage collector\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_GC_H\n#define PZ_GC_H\n\n#include \"pz_option.h\"\n#include \"pz_util.h\"\n\nnamespace pz {\n\n/*\n * The GC recognised pointers even with one high tag bit (for strings) and 2\n * or 3 low tag bits. The implementation uses these values to remove tags\n * from pointers, but users may also depend on them to remove tags.\n */\nconstexpr uintptr_t HIGH_TAG_SHIFT = WORDSIZE_BITS-1;\nconstexpr uintptr_t HIGH_TAG_MASK = static_cast(1)< m_chunk_bop;\n Memory m_chunk_fit;\n\n size_t m_usage = 0;\n size_t m_threshold;\n unsigned m_collections = 0;\n\n // May be null if uninitalised\n AbstractGCTracer * m_trace_global_roots = nullptr;\n\n public:\n Heap(const Options & options);\n ~Heap();\n\n bool init();\n\n void set_roots_tracer(AbstractGCTracer & trace_global_roots) {\n m_trace_global_roots = &trace_global_roots;\n }\n\n // Call finalise to run any objects' finalisers and unmap the \"mmaped\"\n // memory. Or if you're going to exit the program immediately pass\n // (fast=true) to zero things while skipping the cleanup.\n // Be aware the destructor will not do this cleanup.\n bool finalise(bool fast);\n\n const Options & options() const\n {\n return m_options;\n };\n\n void * alloc(size_t size_in_words, GCCapability & gc_cap,\n AllocOpts opts = AllocOpts::NORMAL);\n void * alloc_bytes(size_t size_in_bytes, GCCapability & gc_cap,\n AllocOpts opts = AllocOpts::NORMAL);\n\n /*\n * Note that usage is an over-estimate, it can contain block-internal\n * fragmentation.\n */\n size_t usage() const\n {\n return m_usage;\n };\n\n unsigned collections() const\n {\n return m_collections;\n }\n\n Heap(const Heap &) = delete;\n Heap & operator=(const Heap &) = delete;\n\n void set_meta_info(void * obj, void * meta);\n\n void * meta_info(void * obj) const;\n\n private:\n void collect(const AbstractGCTracer * thread_tracer);\n\n bool is_empty() const\n {\n return usage() == 0;\n };\n\n // Returns the number of cells marked recursively.\n template \n unsigned mark(Cell & cell);\n\n unsigned mark_field(void * ptr);\n\n // Specialised for marking specific cell types. Returns the size of the\n // cell.\n static unsigned do_mark(CellPtrBOP & cell);\n static unsigned do_mark(CellPtrFit & cell);\n\n unsigned do_mark_special_field(CellPtrBOP & cell);\n unsigned do_mark_special_field(CellPtrFit & cell);\n\n void sweep();\n\n void * try_allocate(size_t size_in_words, AllocOpts opts);\n void * try_small_allocate(size_t size_in_words);\n void * try_medium_allocate(size_t size_in_words, AllocOpts opts);\n\n Block * get_block_for_allocation(size_t size_in_words);\n\n Block * allocate_block(size_t size_in_words);\n\n /*\n * Although these two methods are marked as inline they are defined in\n * pz_gc_layout.h with other inline functions.\n */\n\n // The address points to memory within the heap (is inside the payload\n // of an actively used block).\n inline bool is_heap_address(void * ptr) const;\n\n // An address can be converted to a cell here, or Invalid() if the\n // address isn't the first address of a valid cell.\n CellPtrBOP ptr_to_bop_cell(void * ptr) const;\n CellPtrBOP ptr_to_bop_cell_interior(void * ptr) const;\n CellPtrFit ptr_to_fit_cell(void * ptr) const;\n CellPtrFit ptr_to_fit_cell_interior(void * ptr) const;\n\n friend class HeapMarkState;\n\n public:\n void * interior_ptr_to_ptr(void * ptr) const;\n\n#ifdef PZ_DEV\n private:\n void check_heap() const;\n void print_usage_stats(size_t initial_usage) const;\n\n /*\n * This is not used anywhere, it's included so it can be run from gdb to\n * help with debugging.\n */\n void print_addr_info(void * addr) const;\n#endif\n};\n\n} // namespace pz\n\n#endif // ! PZ_GC_IMPL_H\n" }, { "path": "runtime/pz_gc_alloc.cpp", "content": "/*\n * Plasma garbage collector collection procedures\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n\n#include \"pz_util.h\"\n\n#include \"pz_gc.h\"\n#include \"pz_gc_util.h\"\n\n#include \"pz_gc.impl.h\"\n#include \"pz_gc_layout.h\"\n#include \"pz_gc_layout.impl.h\"\n\nnamespace pz {\n\nvoid * Heap::alloc(size_t size_in_words, GCCapability & gc_cap, AllocOpts opts)\n{\n assert(size_in_words > 0);\n\n bool should_collect = false;\n\n#ifdef PZ_DEV\n if (m_options.gc_zealous() && gc_cap.can_gc() && !is_empty()) {\n // Force a collect before each allocation in this mode.\n should_collect = true;\n }\n#endif\n\n if (gc_cap.can_gc() &&\n m_usage + size_in_words * WORDSIZE_BYTES > m_threshold)\n {\n should_collect = true;\n }\n\n if (should_collect) {\n collect(&gc_cap.tracer());\n }\n\n void * cell = try_allocate(size_in_words, opts);\n if (cell) {\n return cell;\n }\n\n if (gc_cap.can_gc() && !should_collect) {\n collect(&gc_cap.tracer());\n cell = try_allocate(size_in_words, opts);\n if (cell) {\n return cell;\n }\n }\n\n gc_cap.oom(size_in_words * WORDSIZE_BYTES);\n return nullptr;\n}\n\nvoid * Heap::alloc_bytes(size_t size_in_bytes, GCCapability & gc_cap,\n AllocOpts opts)\n{\n size_t size_in_words =\n AlignUp(size_in_bytes, WORDSIZE_BYTES) / WORDSIZE_BYTES;\n\n return alloc(size_in_words, gc_cap, opts);\n}\n\nvoid * Heap::try_allocate(size_t size_in_words, AllocOpts opts)\n{\n switch (opts) {\n case NORMAL:\n if (size_in_words <= GC_Small_Alloc_Threshold) {\n return try_small_allocate(size_in_words);\n } else {\n return try_medium_allocate(size_in_words, opts);\n }\n case META:\n case TRACE: {\n return try_medium_allocate(size_in_words, opts);\n }\n default:\n fprintf(stderr, \"Allocation options is invalid\\n\");\n abort();\n }\n}\n\nvoid * Heap::try_small_allocate(size_t size_in_words)\n{\n if (size_in_words < GC_Min_Cell_Size) {\n size_in_words = GC_Min_Cell_Size;\n } else if (size_in_words <= 16) {\n size_in_words = RoundUp(size_in_words, size_t(2));\n } else {\n size_in_words = RoundUp(size_in_words, size_t(4));\n }\n\n /*\n * Try the free list\n */\n Block * block = get_block_for_allocation(size_in_words);\n if (!block) {\n block = allocate_block(size_in_words);\n if (!block) {\n#ifdef PZ_DEV\n if (m_options.gc_trace2()) {\n fprintf(stderr,\n \"Heap full for allocation of %ld words\\n\",\n size_in_words);\n }\n#endif\n return nullptr;\n }\n }\n\n CellPtrBOP cell = block->allocate_cell();\n\n if (!cell.is_valid()) return nullptr;\n\n#ifdef PZ_DEV\n if (m_options.gc_poison()) {\n memset(cell.pointer(), Poison_Byte, block->size() * WORDSIZE_BYTES);\n }\n\n if (m_options.gc_trace2()) {\n fprintf(stderr, \"Allocated %p from free list\\n\", cell.pointer());\n }\n#endif\n\n m_usage += block->size() * WORDSIZE_BYTES;\n\n return cell.pointer();\n}\n\nBlock * Heap::get_block_for_allocation(size_t size_in_words)\n{\n return m_chunk_bop->get_block_for_allocation(size_in_words);\n}\n\nBlock * ChunkBOP::get_block_for_allocation(size_t size_in_words)\n{\n for (unsigned i = 0; i < m_wilderness; i++) {\n Block * block = &(m_blocks[i]);\n\n if (block->is_in_use() && block->size() == size_in_words &&\n !block->is_full())\n {\n return block;\n }\n }\n\n return nullptr;\n}\n\nBlock * Heap::allocate_block(size_t size_in_words)\n{\n Block * block;\n\n block = m_chunk_bop->allocate_block();\n if (!block) return nullptr;\n\n#ifdef PZ_DEV\n if (m_options.gc_trace()) {\n fprintf(stderr, \"Allocated new block for %ld cells\\n\", size_in_words);\n }\n#endif\n\n new (block) Block(m_options, size_in_words);\n\n return block;\n}\n\nBlock * ChunkBOP::allocate_block()\n{\n for (unsigned i = 0; i < m_wilderness; i++) {\n if (!m_blocks[i].is_in_use()) {\n // TODO https://github.com/PlasmaLang/plasma/issues/191\n return &m_blocks[i];\n }\n }\n\n if (m_wilderness >= GC_Block_Per_Chunk) return nullptr;\n\n return &m_blocks[m_wilderness++];\n}\n\nCellPtrBOP Block::allocate_cell()\n{\n assert(is_in_use());\n\n if (m_header.free_list < 0) return CellPtrBOP::Invalid();\n\n CellPtrBOP cell(this, m_header.free_list);\n assert(!cell.is_allocated());\n m_header.free_list = cell.next_in_list();\n assert(m_header.free_list == Header::Empty_Free_List ||\n (m_header.free_list < static_cast(num_cells()) &&\n m_header.free_list >= 0));\n cell.allocate();\n return cell;\n}\n\nvoid * Heap::try_medium_allocate(size_t size_in_words, AllocOpts opts)\n{\n CellPtrFit cell = m_chunk_fit->allocate_cell(size_in_words);\n\n#ifdef PZ_DEV\n if (cell.is_valid() && m_options.gc_poison()) {\n memset(cell.pointer(), Poison_Byte, cell.size() * WORDSIZE_BYTES);\n }\n#endif\n\n /*\n * TODO: we could allow both meta and trace at the same time, there's\n * currently no limitation for that since we're using C++ virtual\n * methods to find the trace code and finaliser.\n */\n *cell.meta() = nullptr;\n switch (opts) {\n case NORMAL:\n case META:\n break;\n case TRACE:\n cell.set_flags(CellPtrFit::CF_TRACE_AND_FINALISE);\n break;\n }\n\n m_usage += cell.size() * WORDSIZE_BYTES + CellPtrFit::CellInfoOffset;\n\n return cell.pointer();\n}\n\nconstexpr size_t CellSplitThreshold =\n Block::Max_Cell_Size + CellPtrFit::CellInfoOffset;\n\nCellPtrFit ChunkFit::allocate_cell(size_t size_in_words)\n{\n CellPtrFit cell = m_header.free_list;\n\n while (cell.is_valid()) {\n if (cell.size() >= size_in_words) {\n m_header.free_list = cell.next_in_list();\n\n // Should we split the cell?\n if (cell.size() >= size_in_words + CellSplitThreshold) {\n CellPtrFit new_cell = cell.split(size_in_words);\n new_cell.set_next_in_list(m_header.free_list);\n m_header.free_list = new_cell;\n }\n\n cell.set_allocated();\n return cell;\n }\n\n cell = cell.next_in_list();\n }\n\n return CellPtrFit::Invalid();\n}\n\nChunkFit::ChunkFit(Heap * heap) : Chunk(heap, CT_FIT)\n{\n CellPtrFit singleCell = first_cell();\n singleCell.init((Payload_Bytes - CellPtrFit::CellInfoOffset) /\n WORDSIZE_BYTES);\n m_header.free_list = singleCell;\n}\n\nCellPtrFit CellPtrFit::split(size_t new_size)\n{\n assert(size() >= 1 + CellPtrFit::CellInfoOffset + new_size);\n#ifdef PZ_DEV\n void * end_of_cell = next_by_size(size());\n#endif\n\n CellPtrFit new_cell(m_chunk, next_by_size(new_size));\n size_t rem_size =\n size() - new_size - CellPtrFit::CellInfoOffset / WORDSIZE_BYTES;\n set_size(new_size);\n new_cell.init(rem_size);\n\n#ifdef PZ_DEV\n assert(new_cell.pointer() == next_in_chunk().pointer());\n assert(end_of_cell == new_cell.next_by_size(new_cell.size()));\n\n check();\n new_cell.check();\n#endif\n\n return new_cell;\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_gc_collect.cpp", "content": "/*\n * Plasma garbage collector collection procedures\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n\n#include \"pz_util.h\"\n\n#include \"pz_gc.h\"\n#include \"pz_gc_util.h\"\n\n#include \"pz_gc.impl.h\"\n#include \"pz_gc_layout.h\"\n#include \"pz_gc_layout.impl.h\"\n\nnamespace pz {\n\n// TODO: This can't be constexpr due to the casts. It'd be nice if it could\n// be.\nvoid * REMOVE_TAG(void * tagged_ptr)\n{\n return reinterpret_cast(reinterpret_cast(tagged_ptr) &\n (~0 ^ TAG_BITS));\n}\n\nvoid Heap::collect(const AbstractGCTracer * trace_thread_roots)\n{\n HeapMarkState state(this);\n\n // There's nothing to collect, the heap is empty.\n if (is_empty()) return;\n\n#ifdef PZ_DEV\n size_t initial_usage = usage();\n\n if (m_options.gc_slow_asserts()) {\n check_heap();\n }\n#endif\n\n#ifdef PZ_DEV\n if (m_options.gc_trace()) {\n fprintf(stderr, \"Tracing from global roots\\n\");\n }\n#endif\n assert(m_trace_global_roots);\n m_trace_global_roots->do_trace(&state);\n#ifdef PZ_DEV\n if (m_options.gc_trace()) {\n fprintf(stderr, \"Done tracing from global roots\\n\");\n }\n#endif\n\n#ifdef PZ_DEV\n if (m_options.gc_trace()) {\n fprintf(stderr, \"Tracing from thread roots (eg stacks)\\n\");\n }\n#endif\n assert(trace_thread_roots);\n trace_thread_roots->do_trace(&state);\n#ifdef PZ_DEV\n if (m_options.gc_trace()) {\n fprintf(stderr, \"Done tracing from stack\\n\");\n }\n#endif\n\n#ifdef PZ_DEV\n if (m_options.gc_trace()) {\n state.print_stats(stderr);\n }\n#endif\n\n sweep();\n m_collections++;\n\n#ifdef PZ_DEV\n if (m_options.gc_slow_asserts()) {\n check_heap();\n }\n if (m_options.gc_usage_stats()) {\n print_usage_stats(initial_usage);\n }\n#endif\n}\n\ntemplate \nunsigned Heap::mark(Cell & cell)\n{\n unsigned num_marked = 0;\n size_t cell_size;\n\n assert(cell.is_valid());\n cell_size = do_mark(cell);\n num_marked++;\n\n if (cell.is_fit_cell()) {\n num_marked += do_mark_special_field(cell);\n // We shouldn't need to reconstruct the cell because this function\n // is templated. there's probably some template-fu for this.\n CellPtrFit cell_fit = ptr_to_fit_cell(cell.pointer());\n assert(cell_fit.is_valid());\n if (cell_fit.flags() & CellPtrFit::CF_TRACE_AND_FINALISE) {\n GCNewTrace * obj = (GCNewTrace *)cell.pointer();\n HeapMarkState ms(this);\n obj->do_trace(&ms);\n num_marked += ms.get_total_marked();\n return num_marked;\n }\n }\n\n void ** ptr = cell.pointer();\n for (unsigned i = 0; i < cell_size; i++) {\n num_marked += mark_field(REMOVE_TAG(ptr[i]));\n }\n\n return num_marked;\n}\n\nunsigned Heap::mark_field(void * cur)\n{\n CellPtrBOP field_bop = ptr_to_bop_cell(cur);\n if (field_bop.is_valid()) {\n /*\n * Note that because we use conservative we may find values that\n * exactly match valid but unallocated cells. Therefore we also\n * test is_allocated().\n */\n if (field_bop.is_allocated() && !field_bop.is_marked()) {\n return mark(field_bop);\n }\n } else {\n CellPtrFit field_fit = ptr_to_fit_cell(cur);\n if (field_fit.is_valid()) {\n /*\n * We also test is_allocated() here, see the above comment.\n */\n if (field_fit.is_allocated() && !field_fit.is_marked()) {\n return mark(field_fit);\n }\n }\n }\n\n return 0;\n}\n\nunsigned Heap::do_mark_special_field(CellPtrBOP & cell)\n{\n return 0;\n}\n\nunsigned Heap::do_mark_special_field(CellPtrFit & cell)\n{\n return mark_field(*cell.meta());\n}\n\nunsigned Heap::do_mark(CellPtrBOP & cell)\n{\n cell.mark();\n return cell.block()->size();\n}\n\nunsigned Heap::do_mark(CellPtrFit & cell)\n{\n cell.mark();\n return cell.size();\n}\n\nvoid Heap::sweep()\n{\n m_chunk_bop->sweep(m_options);\n m_chunk_fit->sweep(m_options);\n\n m_usage = m_chunk_bop->usage() + m_chunk_fit->usage();\n m_threshold = size_t(m_usage * GC_Threshold_Factor);\n}\n\nvoid ChunkBOP::sweep(const Options & options)\n{\n for (unsigned i = 0; i < m_wilderness; i++) {\n if (m_blocks[i].sweep(options)) {\n m_blocks[i].make_unused();\n }\n }\n}\n\nbool Block::sweep(const Options & options)\n{\n if (!is_in_use()) return true;\n\n int free_list = Header::Empty_Free_List;\n unsigned num_used = 0;\n\n for (unsigned i = 0; i < num_cells(); i++) {\n CellPtrBOP cell(this, i);\n if (cell.is_marked()) {\n // Cell is marked, clear the mark bit, keep the allocated bit.\n cell.unmark();\n num_used++;\n } else {\n // Free the cell.\n cell.unallocate();\n#if PZ_DEV\n if (options.gc_poison()) {\n memset(cell.pointer(), Poison_Byte, size() * WORDSIZE_BYTES);\n }\n#endif\n cell.set_next_in_list(free_list);\n free_list = cell.index();\n }\n }\n\n m_header.free_list = free_list;\n\n return num_used == 0;\n}\n\nvoid Block::make_unused()\n{\n m_header.block_type_or_size = Header::Block_Empty;\n}\n\nvoid ChunkFit::sweep(const Options & options)\n{\n for (CellPtrFit cell = first_cell();\n cell.is_valid();\n cell = cell.next_in_chunk())\n {\n if (cell.is_marked()) {\n cell.unmark();\n } else if (cell.is_allocated()) {\n if (cell.flags() & CellPtrFit::CF_TRACE_AND_FINALISE) {\n GCNewTrace * obj =\n reinterpret_cast(cell.pointer());\n obj->~GCNewTrace();\n }\n\n // TODO: this does not free the cell in the sense that it won't\n // be reused later. It marks it as free only.\n cell.set_free();\n\n#ifdef PZ_DEV\n // TODO Implement https://github.com/PlasmaLang/plasma/issues/196\n if (options.gc_poison()) {\n memset(cell.meta(), Poison_Byte, sizeof(*cell.meta()));\n // We cannot poison the first word of the cell since that\n // contains the next pointer.\n memset(reinterpret_cast(cell.pointer()) +\n WORDSIZE_BYTES,\n Poison_Byte,\n (cell.size() - 1) * WORDSIZE_BYTES);\n }\n cell.check();\n#endif\n }\n }\n}\n\n/****************************************************************************/\n\nCellPtrBOP Heap::ptr_to_bop_cell(void * ptr) const\n{\n if (m_chunk_bop->contains_pointer(ptr)) {\n Block * block =\n const_cast(m_chunk_bop.ptr())->ptr_to_block(ptr);\n if (block && block->is_in_use() && block->is_valid_address(ptr)) {\n return CellPtrBOP(block, block->index_of(ptr), ptr);\n } else {\n return CellPtrBOP::Invalid();\n }\n } else {\n return CellPtrBOP::Invalid();\n }\n}\n\nCellPtrBOP Heap::ptr_to_bop_cell_interior(void * ptr) const\n{\n if (m_chunk_bop->contains_pointer(ptr)) {\n Block * block = \n const_cast(m_chunk_bop.ptr())->ptr_to_block(ptr);\n if (block && block->is_in_use()) {\n // Compute index then re-compute pointer to find the true\n // beginning of the cell.\n unsigned index = block->index_of(ptr);\n ptr = block->index_to_pointer(index);\n return CellPtrBOP(block, index, ptr);\n } else {\n return CellPtrBOP::Invalid();\n }\n } else {\n return CellPtrBOP::Invalid();\n }\n}\n\nCellPtrFit Heap::ptr_to_fit_cell(void * ptr) const\n{\n if (m_chunk_fit->contains_pointer(ptr)) {\n // TODO Speed up this search with a crossing-map.\n for (CellPtrFit cell =\n const_cast(m_chunk_fit.ptr())->first_cell();\n cell.is_valid();\n cell = cell.next_in_chunk())\n {\n if (cell.pointer() == ptr) {\n return cell;\n } else if (cell.pointer() > ptr) {\n // The pointer points into the middle of a cell.\n return CellPtrFit::Invalid();\n }\n }\n return CellPtrFit::Invalid();\n } else {\n return CellPtrFit::Invalid();\n }\n}\n\nCellPtrFit Heap::ptr_to_fit_cell_interior(void * ptr) const\n{\n if (m_chunk_fit->contains_pointer(ptr)) {\n // TODO Speed up this search with a crossing-map.\n CellPtrFit prev = CellPtrFit::Invalid();\n for (CellPtrFit cell =\n const_cast(m_chunk_fit.ptr())->first_cell();\n cell.is_valid();\n cell = cell.next_in_chunk())\n {\n if (cell.pointer() == ptr) {\n return cell;\n } else if (cell.pointer() > ptr) {\n if (prev.is_valid()) {\n return prev;\n } else {\n return CellPtrFit::Invalid();\n }\n }\n\n prev = cell;\n }\n return CellPtrFit::Invalid();\n } else {\n return CellPtrFit::Invalid();\n }\n}\n\n/***************************************************************************/\n\nvoid HeapMarkState::mark_root(CellPtrBOP & cell_bop)\n{\n assert(cell_bop.is_valid());\n\n if (cell_bop.is_allocated() && !cell_bop.is_marked()) {\n num_marked += heap->mark(cell_bop);\n num_roots_marked++;\n }\n}\n\nvoid HeapMarkState::mark_root(CellPtrFit & cell_fit)\n{\n assert(cell_fit.is_valid());\n\n if (cell_fit.is_allocated() && !cell_fit.is_marked()) {\n num_marked += heap->mark(cell_fit);\n num_roots_marked++;\n }\n}\n\nvoid HeapMarkState::mark_root(void * heap_ptr)\n{\n CellPtrBOP cell_bop = heap->ptr_to_bop_cell(heap_ptr);\n if (cell_bop.is_valid()) {\n mark_root(cell_bop);\n return;\n }\n\n CellPtrFit cell_fit = heap->ptr_to_fit_cell(heap_ptr);\n if (cell_fit.is_valid()) {\n mark_root(cell_fit);\n return;\n }\n}\n\nvoid HeapMarkState::mark_root_interior(void * heap_ptr)\n{\n // This actually makes the pointer aligned to the GC's alignment. We\n // should have a different macro for this particular use. (issue #154)\n heap_ptr = REMOVE_TAG(heap_ptr);\n\n CellPtrBOP cell_bop = heap->ptr_to_bop_cell_interior(heap_ptr);\n if (cell_bop.is_valid()) {\n mark_root(cell_bop);\n return;\n }\n\n CellPtrFit cell_fit = heap->ptr_to_fit_cell_interior(heap_ptr);\n if (cell_fit.is_valid()) {\n mark_root(cell_fit);\n return;\n }\n}\n\nvoid HeapMarkState::mark_root_conservative(void * root, size_t len_bytes)\n{\n // Mark from the root objects.\n for (void ** p_cur = (void **)root;\n p_cur < (void **)((uint8_t *)root + len_bytes);\n p_cur++)\n {\n mark_root(REMOVE_TAG(*p_cur));\n }\n}\n\nvoid HeapMarkState::mark_root_conservative_interior(void * root,\n size_t len_bytes)\n{\n // Mark from the root objects.\n for (void ** p_cur = (void **)root;\n p_cur < (void **)((uint8_t *)root + len_bytes);\n p_cur++)\n {\n mark_root_interior(*p_cur);\n }\n}\n\nvoid HeapMarkState::print_stats(FILE * stream)\n{\n fprintf(stream,\n \"Marked %d root pointers, marked %u pointers total\\n\",\n num_roots_marked,\n num_marked);\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_gc_debug.cpp", "content": "/*\n * Plasma garbage collector - validation checks & dumping code.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n\n#include \"pz_gc.h\"\n#include \"pz_gc.impl.h\"\n#include \"pz_gc_layout.h\"\n#include \"pz_gc_layout.impl.h\"\n\nnamespace pz {\n\nvoid Heap::check_heap() const\n{\n assert(m_chunk_bop.is_mapped());\n\n const_cast(m_chunk_bop.ptr())->check();\n const_cast(m_chunk_fit.ptr())->check();\n}\n\nvoid ChunkBOP::check()\n{\n assert(m_wilderness < GC_Block_Per_Chunk);\n\n for (unsigned i = 0; i < m_wilderness; i++) {\n m_blocks[i].check();\n }\n}\n\nvoid Block::check()\n{\n if (!is_in_use()) return;\n\n assert(size() >= GC_Min_Cell_Size);\n assert(size() <= Block::Max_Cell_Size);\n assert(num_cells() <= GC_Cells_Per_Block);\n\n unsigned num_free_ = 0;\n for (unsigned i = 0; i < num_cells(); i++) {\n CellPtrBOP cell(this, i);\n\n if (!cell.is_allocated()) {\n assert(!cell.is_marked());\n\n // This is quadratic and should be replaced with an extra bit in the\n // cell header and using that to pass over the cells and the\n // free list once each.\n // https://github.com/PlasmaLang/plasma/issues/202\n assert(is_in_free_list(cell));\n\n num_free_++;\n } else {\n assert(!is_in_free_list(cell));\n }\n }\n\n assert(num_free() == num_free_);\n assert(num_cells() == num_free_ + num_allocated());\n}\n\nbool Block::is_in_free_list(CellPtrBOP & search)\n{\n int cur = m_header.free_list;\n\n while (cur != Header::Empty_Free_List) {\n assert(cur >= 0);\n CellPtrBOP cell(this, unsigned(cur));\n if (search.index() == cell.index()) {\n return true;\n }\n cur = cell.next_in_list();\n }\n\n return false;\n}\n\nunsigned Block::num_free()\n{\n int cur = m_header.free_list;\n unsigned num = 0;\n\n while (cur != Header::Empty_Free_List) {\n num++;\n assert(cur >= 0);\n CellPtrBOP cell(this, unsigned(cur));\n cur = cell.next_in_list();\n }\n\n return num;\n}\n\nvoid ChunkFit::check()\n{\n // Check the free list.\n bool free_list_valid = m_header.free_list.is_valid();\n if (free_list_valid) {\n // Right now the free list isn't really a list.\n assert(!m_header.free_list.next_in_list().is_valid());\n }\n\n CellPtrFit cell = first_cell();\n while (cell.is_valid()) {\n assert(contains_pointer(cell.pointer()));\n cell.check();\n if (!cell.is_allocated()) {\n assert(free_list_valid);\n }\n\n cell = cell.next_in_chunk();\n }\n}\n\nvoid CellPtrFit::check()\n{\n assert(size() < ChunkFit::Payload_Bytes);\n\n switch (info_ptr()->state) {\n case CS_FREE:\n case CS_ALLOCATED:\n case CS_MARKED:\n break;\n default:\n fprintf(stderr, \"Invalid cell state\\n\");\n abort();\n }\n}\n\n/****************************************************************************/\n\nvoid Heap::print_usage_stats(size_t initial_usage) const\n{\n printf(\"\\nHeap usage report\\n=================\\n\");\n printf(\"Usage: %ldKB -> %ldKB\\n\", initial_usage / 1024, usage() / 1024);\n m_chunk_bop->print_usage_stats();\n m_chunk_fit->print_usage_stats();\n printf(\"\\n\");\n}\n\nvoid ChunkBOP::print_usage_stats() const\n{\n printf(\"\\nChunkBOP\\n--------\\n\");\n printf(\"Num blocks: %d/%ld, %ldKB\\n\",\n m_wilderness,\n GC_Block_Per_Chunk,\n m_wilderness * GC_Block_Size / 1024);\n for (unsigned i = 0; i < m_wilderness; i++) {\n m_blocks[i].print_usage_stats();\n }\n}\n\nvoid Block::print_usage_stats() const\n{\n if (is_in_use()) {\n unsigned cells_used = 0;\n for (unsigned i = 0; i < num_cells(); i++) {\n CellPtrBOP cell(const_cast(this), i);\n if (cell.is_allocated()) {\n cells_used++;\n }\n }\n printf(\"Block for %ld-word objects: %d/%d cells\\n\",\n size(),\n cells_used,\n num_cells());\n } else {\n printf(\"Block out of use\\n\");\n }\n}\n\nvoid ChunkFit::print_usage_stats() const\n{\n printf(\"\\nChunkFit\\n--------\\n\");\n\n unsigned num_allocated = 0;\n unsigned num_cells = 0;\n size_t allocated = 0;\n\n CellPtrFit cell = const_cast(this)->first_cell();\n\n while (cell.is_valid()) {\n if (cell.is_allocated()) {\n printf(\"Cell Allocated %ld\\n\", cell.size());\n num_allocated++;\n allocated += cell.size();\n } else {\n printf(\"Cell Free %ld\\n\", cell.size());\n }\n num_cells++;\n cell = cell.next_in_chunk();\n }\n\n printf(\"%d/%d cells, %ld/%ld words allocated\\n\",\n num_allocated,\n num_cells,\n allocated,\n Payload_Bytes / WORDSIZE_BYTES);\n}\n\n/****************************************************************************/\n\ninline const char * bool_string(bool value)\n{\n return value ? \"true\" : \"false\";\n}\n\nvoid Heap::print_addr_info(void * addr) const\n{\n CellPtrBOP cell_bop = ptr_to_bop_cell(addr);\n if (cell_bop.is_valid()) {\n fprintf(stderr, \"Debug: %p is a BOP cell\\n\", addr);\n } else {\n cell_bop = ptr_to_bop_cell_interior(addr);\n if (cell_bop.is_valid()) {\n std::ptrdiff_t diff =\n\t\t (uint8_t *)cell_bop.pointer() - (uint8_t *)addr;\n fprintf(stderr,\n \"Debug: %p is an interior pointer 0x%lx bytes into a \"\n \"BOP cell at %p\",\n addr,\n diff,\n cell_bop.pointer());\n }\n }\n if (cell_bop.is_valid()) {\n fprintf(stderr,\n \"Debug: Cell is index %d in block %p, for size %ld\\n\",\n cell_bop.index(),\n cell_bop.block(),\n cell_bop.block()->size());\n fprintf(stderr,\n \"Debug: Allocated: %s, Marked: %s\\n\",\n bool_string(cell_bop.is_allocated()),\n bool_string(cell_bop.is_marked()));\n return;\n }\n\n CellPtrFit cell_fit = ptr_to_fit_cell(addr);\n if (cell_fit.is_valid()) {\n fprintf(stderr, \"Debug: %p is a Fit cell\\n\", addr);\n } else {\n cell_fit = ptr_to_fit_cell_interior(addr);\n if (cell_fit.is_valid()) {\n std::ptrdiff_t diff =\n (uint8_t *)cell_fit.pointer() - (uint8_t *)addr;\n fprintf(stderr,\n \"Debug: %p is an interior pointer (0x%lx bytes) to a \"\n \"Fit cell at %p\",\n addr,\n diff,\n cell_fit.pointer());\n }\n }\n if (cell_fit.is_valid()) {\n fprintf(stderr,\n \"Debug: Size %ld, Allocated: %s, Marked: %s\\n\",\n cell_fit.size(),\n bool_string(cell_fit.is_allocated()),\n bool_string(cell_fit.is_marked()));\n if (*cell_fit.meta()) {\n fprintf(stderr, \"Debug: Has meta info at %p\\n\", *cell_fit.meta());\n }\n return;\n }\n\n fprintf(stderr, \"Debug: %p is not a current GC cell\\n\", addr);\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_gc_layout.h", "content": "/*\n * Plasma garbage collector memory layout\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_GC_LAYOUT_H\n#define PZ_GC_LAYOUT_H\n\n#include \"pz_gc.h\"\n#include \"pz_gc.impl.h\"\n\nnamespace pz {\n\nconstexpr uint8_t Poison_Byte = 0xF0;\n\n/*\n * These must be a power-of-two and mmap must align to them. 4K is the\n * default.\n */\nstatic const unsigned GC_Block_Log = 13;\nstatic const size_t GC_Block_Size = 1 << (GC_Block_Log - 1);\nstatic const size_t GC_Block_Mask = ~(GC_Block_Size - 1);\nstatic const unsigned GC_Min_Cell_Size = 2;\nstatic const unsigned GC_Cells_Per_Block =\n GC_Block_Size / (GC_Min_Cell_Size * WORDSIZE_BYTES);\n\n/*\n * GC_Chunk_Size is also a power of two and is therefore a multiple of\n * GC_Block_Size. 4MB is the default.\n */\nstatic const unsigned GC_Chunk_Log = 23;\nstatic const size_t GC_Chunk_Size = 1 << (GC_Chunk_Log - 1);\nstatic const size_t GC_Block_Per_Chunk = (GC_Chunk_Size / GC_Block_Size) - 1;\n\n#if PZ_DEV\n// Set this low for testing.\nstatic const size_t GC_Initial_Threshold = 8 * GC_Block_Size;\n#else\nstatic const size_t GC_Initial_Threshold = 64 * GC_Block_Size;\n#endif\nstatic const float GC_Threshold_Factor = 1.5f;\n\n// The threshold for small allocations in words. Allocations of less than\n// this many words are small allocations.\nstatic const size_t GC_Small_Alloc_Threshold = 64;\n\nstatic_assert(GC_Chunk_Size > GC_Block_Size,\n \"Chunks must be larger than blocks\");\n\n/*\n * The heap is made out of blocks and chunks. A chunk contains multiple\n * blocks, which each contain multiple cells.\n */\n\nenum CellType {\n // Used for Invalid cells or unallocated chunks.\n CT_INVALID,\n\n CT_BOP,\n CT_FIT\n};\n\n/*\n * This class should be used by-value as a reference to a cell.\n */\nclass CellPtr\n{\n protected:\n void ** m_ptr;\n CellType m_type;\n\n constexpr CellPtr() : m_ptr(nullptr), m_type(CT_INVALID) {}\n\n public:\n constexpr explicit CellPtr(void * ptr, CellType type)\n : m_ptr(static_cast(ptr))\n , m_type(type)\n {}\n\n void ** pointer()\n {\n return m_ptr;\n }\n\n bool is_valid() const\n {\n return m_ptr != nullptr;\n }\n bool is_bop_cell() const\n {\n return m_type == CT_BOP;\n }\n bool is_fit_cell() const\n {\n return m_type == CT_FIT;\n }\n};\n\n/*\n * Chunks\n */\nclass Chunk\n{\n protected:\n Heap * m_heap;\n CellType m_type;\n\n private:\n Chunk(const Chunk &) = delete;\n void operator=(const Chunk &) = delete;\n\n Chunk(Heap * heap) : m_heap(heap), m_type(CT_INVALID) {}\n\n protected:\n Chunk(Heap * heap, CellType type) : m_heap(heap), m_type(type) {}\n\n public:\n /*\n * True if this pointer lies within the allocated part of this chunk.\n */\n bool contains_pointer(void * ptr) const\n {\n return ptr >= this &&\n ptr < (reinterpret_cast(this) + GC_Chunk_Size);\n };\n};\n\n} // namespace pz\n\n#include \"pz_gc_layout_bop.h\"\n#include \"pz_gc_layout_fit.h\"\n\nnamespace pz {\n\nstatic_assert(\n GC_Small_Alloc_Threshold <= Block::Max_Cell_Size,\n \"The small alloc threshold must be less than the maximum cell size\");\n\n} // namespace pz\n\n#endif // ! PZ_GC_LAYOUT_H\n" }, { "path": "runtime/pz_gc_layout.impl.h", "content": "/*\n * Plasma garbage collector memory layout\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_GC_LAYOUT_IMPL_H\n#define PZ_GC_LAYOUT_IMPL_H\n\n#include \"pz_gc_layout.h\"\n\nnamespace pz {\n\n/*\n * Definitions for some inline functions that must be defined here after\n * the class definitions.\n */\n\ninline Block * ptr_to_block(void * ptr)\n{\n return reinterpret_cast(reinterpret_cast(ptr) &\n GC_Block_Mask);\n}\n\nbool Heap::is_heap_address(void * ptr) const\n{\n if (m_chunk_bop->contains_pointer(ptr)) {\n Block * block = const_cast(m_chunk_bop.ptr())->ptr_to_block(ptr);\n if (!block) return false;\n if (!block->is_in_use()) return false;\n return block->is_in_payload(ptr);\n } else if (m_chunk_fit->contains_pointer(ptr)) {\n return true;\n } else {\n return false;\n }\n}\n\n/**************************************************************************/\n\nCellPtrBOP::CellPtrBOP(Block * block, unsigned index, void * ptr)\n : CellPtr(ptr, CT_BOP)\n , m_block(block)\n , m_index(index)\n{}\n\nCellPtrBOP::CellPtrBOP(Block * block, unsigned index)\n : CellPtr(block->index_to_pointer(index), CT_BOP)\n , m_block(block)\n , m_index(index)\n{}\n\nbool CellPtrBOP::is_allocated() const\n{\n return *block()->cell_bits(index()) & Bits_Allocated;\n}\n\nbool CellPtrBOP::is_marked() const\n{\n return *block()->cell_bits(index()) & Bits_Marked;\n}\n\nvoid CellPtrBOP::allocate()\n{\n assert(*block()->cell_bits(index()) == 0);\n *block()->cell_bits(index()) = Bits_Allocated;\n}\n\nvoid CellPtrBOP::unallocate()\n{\n assert(!is_marked());\n *block()->cell_bits(index()) = 0;\n}\n\nvoid CellPtrBOP::mark()\n{\n assert(is_allocated());\n *block()->cell_bits(index()) = Bits_Allocated | Bits_Marked;\n}\n\nvoid CellPtrBOP::unmark()\n{\n assert(is_allocated());\n *block()->cell_bits(index()) = Bits_Allocated;\n}\n\nbool Block::is_valid_address(const void * ptr) const\n{\n assert(is_in_use());\n\n return is_in_payload(ptr) && ((reinterpret_cast(ptr) -\n reinterpret_cast(m_bytes)) %\n (size() * WORDSIZE_BYTES)) == 0;\n}\n\nunsigned Block::index_of(const void * ptr) const\n{\n return (reinterpret_cast(ptr) - reinterpret_cast(m_bytes)) /\n (size() * WORDSIZE_BYTES);\n}\n\nvoid ** Block::index_to_pointer(unsigned index)\n{\n assert(index < num_cells());\n\n unsigned offset = index * size() * WORDSIZE_BYTES;\n assert(offset + size() <= Payload_Bytes);\n\n return reinterpret_cast(&m_bytes[offset]);\n}\n\nBlock * ChunkBOP::ptr_to_block(void * ptr)\n{\n if (ptr >= &m_blocks[0] && ptr < &m_blocks[m_wilderness]) {\n // This is a call to the outer ptr_to_block, not a recursive call.\n // It must have the pz:: qualifier.\n return pz::ptr_to_block(ptr);\n } else {\n return nullptr;\n }\n}\n\n/**************************************************************************/\n\nCellPtrFit::CellPtrFit(ChunkFit * chunk, void * ptr)\n : CellPtr(reinterpret_cast(ptr), CT_FIT)\n , m_chunk(chunk)\n{\n assert(chunk->contains_pointer(ptr));\n}\n\nvoid * CellPtrFit::next_by_size(size_t size)\n{\n return reinterpret_cast(pointer()) + size * WORDSIZE_BYTES +\n CellInfoOffset;\n}\n\nCellPtrFit CellPtrFit::next_in_chunk()\n{\n assert(size() > 0);\n void * next = next_by_size(size());\n if (m_chunk->contains_pointer(next)) {\n return CellPtrFit(m_chunk, next);\n } else {\n return CellPtrFit::Invalid();\n }\n}\n\nbool CellPtrFit::is_valid()\n{\n bool res = CellPtr::is_valid();\n if (res) {\n assert(size() > 0);\n // TODO also check flags.\n }\n return res;\n}\n\nCellPtrFit CellPtrFit::next_in_list()\n{\n if (*pointer()) {\n return CellPtrFit(m_chunk, *pointer());\n } else {\n return CellPtrFit::Invalid();\n }\n}\n\n} // namespace pz\n\n#endif // ! PZ_GC_LAYOUT_IMPL_H\n" }, { "path": "runtime/pz_gc_layout_bop.h", "content": "/*\n * Plasma garbage collector memory layout - bop allocation.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_GC_LAYOUT_BOP_H\n#define PZ_GC_LAYOUT_BOP_H\n\nnamespace pz {\n\n/*\n * A cell in the \"bag of pages\" storage class.\n */\nclass CellPtrBOP : public CellPtr\n{\n private:\n Block * m_block;\n unsigned m_index;\n\n constexpr CellPtrBOP() : m_block(nullptr), m_index(0) {}\n\n int * free_list_data()\n {\n return reinterpret_cast(m_ptr);\n }\n\n public:\n inline explicit CellPtrBOP(Block * block, unsigned index, void * ptr);\n inline explicit CellPtrBOP(Block * block, unsigned index);\n\n Block * block() const\n {\n return m_block;\n }\n unsigned index() const\n {\n return m_index;\n }\n\n void set_next_in_list(int next)\n {\n *free_list_data() = next;\n }\n int next_in_list()\n {\n return *free_list_data();\n }\n\n static constexpr CellPtrBOP Invalid()\n {\n return CellPtrBOP();\n }\n\n constexpr static uintptr_t Bits_Allocated = 0x01;\n constexpr static uintptr_t Bits_Marked = 0x02;\n\n inline bool is_allocated() const;\n inline bool is_marked() const;\n inline void allocate();\n inline void unallocate();\n inline void mark();\n inline void unmark();\n};\n\n/*\n * Blocks\n */\nclass Block\n{\n private:\n struct Header {\n const static size_t Block_Empty = 0;\n size_t block_type_or_size;\n\n const static int Empty_Free_List = -1;\n int free_list;\n\n // Really a bytemap.\n uint8_t bitmap[GC_Cells_Per_Block];\n\n explicit Header(size_t cell_size_)\n : block_type_or_size(cell_size_)\n , free_list(Empty_Free_List)\n {\n assert(cell_size_ >= GC_Min_Cell_Size);\n }\n Header() {}\n };\n\n Header m_header;\n\n public:\n static constexpr size_t Header_Bytes =\n RoundUp(sizeof(m_header), WORDSIZE_BYTES);\n static constexpr size_t Payload_Bytes = GC_Block_Size - Header_Bytes;\n static constexpr size_t Max_Cell_Size = Payload_Bytes / WORDSIZE_BYTES;\n\n private:\n alignas(WORDSIZE_BYTES) uint8_t m_bytes[Payload_Bytes];\n\n public:\n explicit Block(const Options & options, size_t cell_size_);\n\n // This constructor won't touch any memory and can be used to construct\n // uninitialised Blocks within Chunks.\n Block() {}\n\n Block(const Block &) = delete;\n void operator=(const Block &) = delete;\n\n // Size in words.\n size_t size() const\n {\n assert(is_in_use());\n return m_header.block_type_or_size;\n }\n\n unsigned num_cells() const\n {\n unsigned num = Payload_Bytes / (size() * WORDSIZE_BYTES);\n assert(num <= GC_Cells_Per_Block);\n return num;\n }\n\n bool is_in_payload(const void * ptr) const\n {\n return ptr >= m_bytes && ptr < &m_bytes[Payload_Bytes];\n }\n\n inline bool is_valid_address(const void * ptr) const;\n\n /*\n * Must also work for interior pointers.\n */\n inline unsigned index_of(const void * ptr) const;\n\n inline void ** index_to_pointer(unsigned index);\n\n private:\n /*\n * TODO: Can the const and non-const versions somehow share an\n * implementation? Would that actually save any code lines?\n */\n const uint8_t * cell_bits(unsigned index) const\n {\n assert(index < num_cells());\n return &(m_header.bitmap[index]);\n }\n\n uint8_t * cell_bits(unsigned index)\n {\n assert(index < num_cells());\n return &(m_header.bitmap[index]);\n }\n friend CellPtrBOP;\n\n public:\n bool is_full() const\n {\n assert(is_in_use());\n return m_header.free_list == Header::Empty_Free_List;\n }\n\n bool is_in_use() const\n {\n return m_header.block_type_or_size != Header::Block_Empty;\n }\n\n unsigned num_allocated();\n size_t usage();\n\n // Returns true if the entire block is empty and may be reclaimed.\n bool sweep(const Options & options);\n\n void make_unused();\n\n CellPtrBOP allocate_cell();\n\n#ifdef PZ_DEV\n void print_usage_stats() const;\n\n void check();\n\n private:\n bool is_in_free_list(CellPtrBOP & cell);\n\n // Calculate the number of free cells via the free list length.\n unsigned num_free();\n#endif\n};\n\nstatic_assert(sizeof(Block) == GC_Block_Size,\n \"sizeof(Block) must match specified block size\");\n\n/*\n * ChunkBOP is a chunk containing BIBOP style blocks of cells.\n */\nclass ChunkBOP : public Chunk\n{\n private:\n uint32_t m_wilderness;\n\n alignas(GC_Block_Size) Block m_blocks[GC_Block_Per_Chunk];\n\n public:\n ChunkBOP(Heap * heap) : Chunk(heap, CT_BOP), m_wilderness(0) {}\n\n /*\n * Get an unused block.\n *\n * The caller must initialise the block, this is require to ensure that\n * it is properly marked as allocated.\n */\n Block * allocate_block();\n\n /*\n * The size of the allocated portion of this Chunk.\n */\n size_t usage();\n\n bool is_empty() const;\n\n /*\n * If this pointer lies within the allocated part of this chunk then\n * return its block.\n */\n inline Block * ptr_to_block(void * ptr);\n\n /*\n * Get an block for the given size that is not full (we want to\n * allocate a cell of this size).\n */\n Block * get_block_for_allocation(size_t size_in_words);\n\n void sweep(const Options & options);\n\n#ifdef PZ_DEV\n void print_usage_stats() const;\n\n void check();\n#endif\n};\n\nstatic_assert(sizeof(ChunkBOP) == GC_Chunk_Size,\n \"sizeof(ChunkBOP) must match specified chunk size\");\n\n} // namespace pz\n\n#endif // ! PZ_GC_LAYOUT_BOP_H\n" }, { "path": "runtime/pz_gc_layout_fit.h", "content": "/*\n * Plasma garbage collector memory layout - fit allocation.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_GC_LAYOUT_FIT_H\n#define PZ_GC_LAYOUT_FIT_H\n\nnamespace pz {\n\n/*\n * A Fit-allocated cell\n */\nclass CellPtrFit : public CellPtr\n{\n private:\n ChunkFit * m_chunk;\n\n constexpr CellPtrFit() : CellPtr(nullptr, CT_INVALID), m_chunk(nullptr) {}\n\n enum CellState : uint8_t { CS_FREE, CS_ALLOCATED, CS_MARKED };\n\n public:\n enum CellFlags : uint8_t { CF_NONE = 0x00, CF_TRACE_AND_FINALISE = 0x01 };\n\n private:\n /*\n * We could pack size and flags into the same value, but that's a later\n * optimisation because it's tricky to do portably and still keep using\n * size_t which we use elsewhere (avoid losing data when casting).\n */\n struct CellInfo {\n size_t size;\n CellState state;\n CellFlags flags;\n void * meta;\n };\n\n public:\n static constexpr size_t CellInfoOffset =\n AlignUp(sizeof(CellInfo), WORDSIZE_BYTES);\n\n private:\n /*\n * The memory word before a cell contains the size and two flags in the\n * highest bits.\n */\n CellInfo * info_ptr()\n {\n return reinterpret_cast(\n reinterpret_cast(pointer()) - CellInfoOffset);\n }\n\n void set_size(size_t new_size)\n {\n assert(new_size >= 1 && new_size < GC_Chunk_Size);\n info_ptr()->size = new_size;\n }\n\n public:\n inline explicit CellPtrFit(ChunkFit * chunk, void * ptr);\n\n constexpr static CellPtrFit Invalid()\n {\n return CellPtrFit();\n }\n\n void init(size_t size)\n {\n info_ptr()->state = CS_FREE;\n set_size(size);\n clear_next_in_list();\n }\n\n // This non-virtual override exists only to oppitunitistically provide an\n // assertion.\n inline bool is_valid();\n\n size_t size()\n {\n return info_ptr()->size;\n }\n\n bool is_allocated()\n {\n return info_ptr()->state != CS_FREE;\n }\n bool is_marked()\n {\n return info_ptr()->state == CS_MARKED;\n }\n void mark()\n {\n assert(info_ptr()->state != CS_FREE);\n info_ptr()->state = CS_MARKED;\n }\n void unmark()\n {\n assert(is_marked());\n info_ptr()->state = CS_ALLOCATED;\n }\n void set_allocated()\n {\n assert(info_ptr()->state == CS_FREE);\n info_ptr()->state = CS_ALLOCATED;\n info_ptr()->flags = CF_NONE;\n }\n void set_free()\n {\n assert(info_ptr()->state == CS_ALLOCATED);\n info_ptr()->state = CS_FREE;\n }\n\n void ** meta()\n {\n return &(info_ptr()->meta);\n }\n\n CellFlags flags()\n {\n return info_ptr()->flags;\n }\n void set_flags(CellFlags flags)\n {\n info_ptr()->flags = flags;\n }\n\n inline CellPtrFit next_in_list();\n void set_next_in_list(CellPtrFit & next)\n {\n *pointer() = next.pointer();\n }\n void clear_next_in_list()\n {\n *pointer() = nullptr;\n }\n\n inline void * next_by_size(size_t size);\n inline CellPtrFit next_in_chunk();\n\n CellPtrFit split(size_t new_size);\n\n#ifdef PZ_DEV\n void check();\n#endif\n};\n\n/*\n * ChunkFit is a chunk for allocation of larger cells using best-fit with\n * cell splitting.\n */\nclass ChunkFit : public Chunk\n{\n private:\n struct Header {\n CellPtrFit free_list;\n\n Header() : free_list(CellPtrFit::Invalid()) {}\n };\n\n public:\n static constexpr size_t Header_Bytes =\n RoundUp(sizeof(Chunk) + sizeof(Header), WORDSIZE_BYTES);\n static constexpr size_t Payload_Bytes = GC_Chunk_Size - Header_Bytes;\n\n private:\n Header m_header;\n\n alignas(WORDSIZE_BYTES) char m_bytes[Payload_Bytes];\n\n public:\n ChunkFit(Heap * heap);\n\n /*\n * Bytes used in this chunk, including cell headers.\n */\n size_t usage();\n\n bool is_empty();\n\n CellPtrFit allocate_cell(size_t size_in_words);\n\n CellPtrFit first_cell()\n {\n return CellPtrFit(\n this,\n reinterpret_cast(m_bytes) + CellPtrFit::CellInfoOffset);\n }\n\n void sweep(const Options & options);\n\n#ifdef PZ_DEV\n void check();\n\n void print_usage_stats() const;\n#endif\n};\n\nstatic_assert(sizeof(ChunkFit) == GC_Chunk_Size,\n \"sizeof(ChunkFit) must match specified chunk size\");\n\n} // namespace pz\n\n#endif // ! PZ_GC_LAYOUT_FIT_H⎋\n" }, { "path": "runtime/pz_gc_util.cpp", "content": "/*\n * Plasma GC rooting, scopes & C++ allocation utilities\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \"pz_util.h\"\n\n#include \"pz_gc.h\"\n#include \"pz_gc_util.h\"\n\n#include \"pz_gc.impl.h\"\n\nnamespace pz {\n\nvoid * GCCapability::alloc(size_t size_in_words, AllocOpts opts)\n{\n#ifdef PZ_DEV\n assert(m_is_top);\n#endif\n return m_heap.alloc(size_in_words, *this, opts);\n}\n\nvoid * GCCapability::alloc_bytes(size_t size_in_bytes, AllocOpts opts)\n{\n#ifdef PZ_DEV\n assert(m_is_top);\n#endif\n return m_heap.alloc_bytes(size_in_bytes, *this, opts);\n}\n\nconst AbstractGCTracer & GCCapability::tracer() const\n{\n assert(can_gc());\n return *static_cast(this);\n}\n\nbool GCCapability::can_gc() const\n{\n const GCCapability *cur = this;\n\n do {\n switch (cur->m_can_gc) {\n case IS_ROOT:\n assert(!cur->m_parent);\n // If this is the root, then we cannot GC because we cannot call\n // trace() on this GCCapability.\n return this != cur;\n case CANNOT_GC:\n return false;\n case CAN_GC:\n break;\n }\n cur = cur->m_parent;\n } while (cur);\n\n return true;\n}\n\nstatic void abort_oom(size_t size_bytes)\n{\n fprintf(\n stderr, \"Out of memory, tried to allocate %lu bytes.\\n\", size_bytes);\n abort();\n}\n\nvoid GCCapability::trace_parent(HeapMarkState * state) const {\n if (m_parent && m_parent->can_gc()) {\n m_parent->tracer().do_trace(state);\n }\n}\n\nvoid GCThreadHandle::oom(size_t size_bytes)\n{\n abort_oom(size_bytes);\n}\n\nvoid AbstractGCTracer::oom(size_t size_bytes)\n{\n abort_oom(size_bytes);\n}\n\nvoid GCTracer::do_trace(HeapMarkState * state) const\n{\n for (void * root : m_roots) {\n state->mark_root(*(void **)root);\n }\n\n trace_parent(state);\n}\n\nvoid GCTracer::add_root(void * root)\n{\n m_roots.push_back(root);\n}\n\nvoid GCTracer::remove_root(void * root)\n{\n assert(!m_roots.empty());\n assert(m_roots.back() == root);\n m_roots.pop_back();\n}\n\nNoGCScope::NoGCScope(GCCapability & gc_cap)\n : GCCapability(gc_cap, CANNOT_GC)\n#ifdef PZ_DEV\n , m_needs_check(true)\n#endif\n , m_did_oom(false)\n{ }\n\nNoGCScope::~NoGCScope()\n{\n#ifdef PZ_DEV\n if (m_needs_check) {\n fprintf(\n stderr,\n \"Caller did not check the NoGCScope before the destructor ran.\\n\");\n abort();\n }\n#endif\n\n if (m_did_oom) {\n fprintf(stderr,\n \"Out of memory, tried to allocate %lu bytes.\\n\",\n m_oom_size);\n abort();\n }\n}\n\nvoid NoGCScope::oom(size_t size_bytes)\n{\n if (!m_did_oom) {\n m_did_oom = true;\n m_oom_size = size_bytes;\n }\n}\n\nvoid NoGCScope::abort_for_oom_slow(const char * label)\n{\n assert(m_did_oom);\n fprintf(stderr,\n \"Out of memory while %s, tried to allocate %ld bytes.\\n\",\n label,\n m_oom_size);\n abort();\n}\n\n/****************************************************************************/\n\nstatic void * do_new(size_t size, GCCapability & gc_cap, AllocOpts opts);\n\n/*\n * This is not exactly conformant to C++ normals/contracts. It doesn't call\n * the new handler when allocation fails which is what should normally\n * happen. However the GC's alloc_bytes function already makes an attempt to\n * recover memory via the GCCapability parameter.\n *\n * See: Scott Meyers: Effective C++ Digital Collection, Item 51 regarding\n * this behaviour.\n */\nvoid * GCNew::operator new(size_t size, GCCapability & gc_cap)\n{\n return do_new(size, gc_cap, NORMAL);\n}\n\nvoid * GCNewTrace::operator new(size_t size, GCCapability & gc_cap)\n{\n return do_new(size, gc_cap, TRACE);\n}\n\nstatic void * do_new(size_t size, GCCapability & gc_cap, AllocOpts opts)\n{\n if (0 == size) {\n size = 1;\n }\n\n void * mem = gc_cap.alloc_bytes(size, opts);\n if (!mem) {\n fprintf(stderr, \"Out of memory in operator new!\\n\");\n abort();\n }\n\n return mem;\n}\n\n} // namespace pz\n\nvoid * operator new[](size_t size, pz::GCCapability & gc_cap)\n{\n return pz::do_new(size, gc_cap, pz::NORMAL);\n}\n" }, { "path": "runtime/pz_gc_util.h", "content": "/*\n * Plasma GC rooting, scopes & C++ allocation utilities\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_GC_UTIL_H\n#define PZ_GC_UTIL_H\n\n#include \n\n#include \"pz_gc.h\"\n\nnamespace pz {\n\n// Forward declarations.\nclass AbstractGCTracer;\n\n/*\n * This is the base class that the GC will use to determine if its legal to\n * GC. Do not create subclasses of this, use only AbstractGCTracer.\n */\nclass GCCapability\n{\n public:\n enum CanGC {\n IS_ROOT,\n CAN_GC,\n CANNOT_GC\n };\n\n private:\n Heap &m_heap;\n#ifdef PZ_DEV\n GCCapability *m_parent;\n#else\n const GCCapability *m_parent;\n#endif\n const CanGC m_can_gc;\n#ifdef PZ_DEV\n bool m_is_top = true;\n#endif\n\n protected:\n GCCapability(Heap & heap, CanGC can_gc)\n : m_heap(heap)\n , m_parent(nullptr)\n , m_can_gc(can_gc) {}\n // TODO: Check heirachy.\n GCCapability(GCCapability & gc_cap, CanGC can_gc)\n : m_heap(gc_cap.heap())\n , m_parent(&gc_cap)\n , m_can_gc(can_gc)\n {\n#ifdef PZ_DEV\n gc_cap.m_is_top = false;\n#endif\n }\n\n#ifdef PZ_DEV\n ~GCCapability() {\n assert(m_is_top);\n if (m_parent) {\n assert(!m_parent->m_is_top);\n m_parent->m_is_top = true;\n }\n }\n#endif\n\n public:\n void * alloc(size_t size_in_words, AllocOpts opts = AllocOpts::NORMAL);\n void * alloc_bytes(size_t size_in_bytes,\n AllocOpts opts = AllocOpts::NORMAL);\n\n Heap & heap() const {\n return m_heap;\n }\n\n bool can_gc() const;\n\n // Called by the GC if we couldn't allocate this much memory.\n virtual void oom(size_t size_bytes) = 0;\n\n /*\n * This casts to AbstractGCTracer whenever can_gc() returns true, so\n * AbstractGCTracer must be the only subclass that overrides can_gc() to\n * return true.\n */\n const AbstractGCTracer & tracer() const;\n\n protected:\n void trace_parent(HeapMarkState *) const;\n};\n\n// Each thread gets one of these. Do not create more than one per thread.\nclass GCThreadHandle : public GCCapability {\n public:\n GCThreadHandle(Heap & heap) : GCCapability(heap, IS_ROOT) {}\n\n void oom(size_t size_bytes) override;\n};\n\n/*\n * AbstractGCTracer helps the GC find the roots, it traces in order to find\n * the GC roots.\n *\n * Roots are traced from two different sources (both use this class).\n * Global roots and thread-local roots.\n */\nclass AbstractGCTracer : public GCCapability\n{\n public:\n AbstractGCTracer(GCCapability & gc) : GCCapability(gc, CAN_GC) {}\n\n void oom(size_t size) override;\n virtual void do_trace(HeapMarkState *) const = 0;\n\n private:\n /*\n * A work-around for PZ\n */\n AbstractGCTracer(Heap & heap) : GCCapability(heap, CAN_GC) { }\n friend class PZ;\n};\n\n/*\n * GCTracer helps the GC find the roots, it traces in order to find the\n * GC roots.\n */\nclass GCTracer : public AbstractGCTracer\n{\n private:\n std::vector m_roots;\n\n public:\n GCTracer(GCCapability & gc_cap) : AbstractGCTracer(gc_cap) {}\n\n void add_root(void * root);\n\n /*\n * The roots must be removed in LIFO order.\n */\n void remove_root(void * root);\n\n GCTracer(const GCTracer &) = delete;\n GCTracer & operator=(const GCTracer &) = delete;\n\n void do_trace(HeapMarkState * state) const override;\n};\n\ntemplate \nclass Root\n{\n private:\n T * m_gc_ptr;\n GCTracer & m_tracer;\n\n public:\n explicit Root(GCTracer & t) : m_gc_ptr(nullptr), m_tracer(t)\n {\n m_tracer.add_root(&m_gc_ptr);\n }\n\n explicit Root(GCTracer & t, T * ptr) : m_gc_ptr(ptr), m_tracer(t)\n {\n m_tracer.add_root(&m_gc_ptr);\n }\n\n Root(const Root & r) : m_gc_ptr(r.m_gc_ptr), m_tracer(r.m_tracer)\n {\n m_tracer.add_root(&m_gc_ptr);\n }\n\n const Root & operator=(const Root & r)\n {\n m_gc_ptr = r.gc_ptr;\n }\n\n ~Root()\n {\n m_tracer.remove_root(&m_gc_ptr);\n }\n\n const Root & operator=(T * ptr)\n {\n m_gc_ptr = ptr;\n return *this;\n }\n\n T * operator->() const\n {\n return m_gc_ptr;\n }\n\n const T * ptr() const {\n return m_gc_ptr;\n }\n T * ptr() {\n return m_gc_ptr;\n }\n\n const T & get() const {\n return *m_gc_ptr;\n }\n T & get() {\n return *m_gc_ptr;\n }\n};\n\n/*\n * Use this RAII class to create scopes where GC is forbidden.\n *\n * Needing to GC (due to memory pressure) is handled by returning nullptr\n * (normally allocation is infalliable). This class will return nullptr and\n * the require the caller to check either is_oom() or abort_if_oom() before\n * the end of the NoGCScope. You can allocate a series of things and\n * perform the check at the end of the scope.\n *\n * This is not C++ conformant. We'd need to use the C++ new handler or\n * exceptions or nothrow forms to do that. We could be tempting fate but it\n * seems that it's okay either to throw or use -fno-exceptions. See:\n * https://blog.mozilla.org/nnethercote/2011/01/18/the-dangers-of-fno-exceptions/\n */\nclass NoGCScope final : public GCCapability\n{\n private:\n#ifdef PZ_DEV\n bool m_needs_check;\n#endif\n\n bool m_did_oom;\n size_t m_oom_size;\n\n public:\n // The constructor may use the tracer to perform an immediate\n // collection, or if it is a NoGCScope allow the direct nesting.\n NoGCScope(GCCapability & gc_cap);\n ~NoGCScope();\n\n void oom(size_t size) override;\n\n // Assert if there was an OOM. This is available for inlining because\n // we don't want to leave the fast-path unless the test fails.\n void abort_if_oom(const char * label)\n {\n if (m_did_oom) {\n abort_for_oom_slow(label);\n }\n#if PZ_DEV\n // If there are further allocations this won't be reset before the\n // destructor runs. This isn't fool-proof.\n m_needs_check = false;\n#endif\n }\n\n bool is_oom()\n {\n#if PZ_DEV\n m_needs_check = false;\n#endif\n return m_did_oom;\n }\n\n protected:\n void abort_for_oom_slow(const char * label);\n};\n\nclass GCNew\n{\n public:\n /*\n * Operator new is infalliable, it'll abort the program if the\n * GC returns null, which it can only do in a NoGCScope.\n */\n void * operator new(size_t size, GCCapability & gc_cap);\n // We don't need a placement-delete or regular-delete because we use GC.\n};\n\n/*\n * A GC allocatable object with tracing and a finaliser. This is necessary\n * if the class uses the regular heap (eg via STL collections).\n */\nclass GCNewTrace : public GCNew\n{\n public:\n virtual ~GCNewTrace(){};\n virtual void do_trace(HeapMarkState * marker) const = 0;\n\n void * operator new(size_t size, GCCapability & gc_cap);\n};\n\n} // namespace pz\n\n// Array allocation for any type. Intended for arrays of primative types\n// like integers, floats and pointers.\nvoid * operator new[](size_t size, pz::GCCapability & gc_cap);\n\n#endif // ! PZ_GC_UTIL_H\n" }, { "path": "runtime/pz_generic.cpp", "content": "/*\n * Plasma bytecode exection (generic portable version)\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n#include \n\n#include \"pz.h\"\n#include \"pz_code.h\"\n#include \"pz_cxx_future.h\"\n#include \"pz_interp.h\"\n#include \"pz_trace.h\"\n#include \"pz_util.h\"\n\n#include \"pz_generic_closure.h\"\n#include \"pz_generic_run.h\"\n\nnamespace pz {\n\n/* Must match or exceed ptag_bits from src/core.types.m */\nconst unsigned num_tag_bits = 2;\nconst uintptr_t tag_bits = 0x3;\n\n/*\n * Run the program\n *\n ******************/\n\nint run(PZ & pz, const Options & options, GCCapability &gc)\n{\n uint8_t * wrapper_proc = nullptr;\n unsigned wrapper_proc_size;\n int retcode = 0;\n ImmediateValue imv_none;\n\n assert(PZT_LAST_TOKEN < 256);\n\n Context context(gc);\n if (!context.allocate()) {\n fprintf(stderr, \"Could not allocate context\\n\");\n return PZ_EXIT_RUNTIME_ERROR; \n }\n\n ScopeExit finalise([&context, &retcode, &options]{\n if (!context.release(options.fast_exit())) {\n fprintf(stderr, \"Error releasing memory\\n\");\n if (retcode == 0) {\n retcode = PZ_EXIT_RUNTIME_NONFATAL;\n }\n }\n });\n\n /*\n * Assemble a special procedure that exits the interpreter and put its\n * address on the call stack.\n */\n memset(&imv_none, 0, sizeof(imv_none));\n wrapper_proc_size = write_instr(nullptr, 0, PZI_END);\n wrapper_proc =\n static_cast(context.alloc_bytes(wrapper_proc_size, META));\n heap_set_meta_info(&context.heap(), wrapper_proc, nullptr);\n write_instr(wrapper_proc, 0, PZI_END);\n context.return_stack[0] = nullptr;\n // Wrapper proc is tracablo here.\n context.return_stack[1] = wrapper_proc;\n context.rsp = 1;\n\n // Determine the entry procedure.\n Library * program = pz.program_lib();\n Closure * entry_closure = program ? program->entry_closure() : nullptr;\n if (!entry_closure) {\n fprintf(stderr, \"No entry closure\\n\");\n return PZ_EXIT_RUNTIME_ERROR; \n }\n PZOptEntrySignature entry_signature = program->entry_signature();\n switch (entry_signature) {\n case PZ_OPT_ENTRY_SIG_PLAIN:\n break;\n case PZ_OPT_ENTRY_SIG_ARGS:\n fprintf(stderr,\n \"Unsupported, cannot execute programs that \"\n \"accept command line arguments. (Bug #283)\\n\");\n return PZ_EXIT_RUNTIME_ERROR;\n }\n\n#ifdef PZ_DEV\n trace_enabled = options.interp_trace();\n#endif\n int program_retcode =\n generic_main_loop(context, &pz.heap(), entry_closure, pz);\n retcode = program_retcode ? program_retcode : retcode;\n\n return retcode;\n}\n\nContext::Context(GCCapability & gc)\n : AbstractGCTracer(gc)\n , ip(nullptr)\n , env(nullptr)\n , return_stack(\"return stack\")\n , rsp(0)\n , expr_stack(\"expression stack\")\n , esp(0)\n{}\n\nContext::~Context()\n{\n assert(!return_stack.is_mapped());\n assert(!expr_stack.is_mapped());\n}\n\nbool Context::allocate() {\n if (!return_stack.allocate_guarded(RETURN_STACK_SIZE * sizeof(uint8_t*))) {\n return false;\n }\n\n if (!expr_stack.allocate_guarded(EXPR_STACK_SIZE * sizeof(StackValue))) {\n return false;\n }\n\n return true;\n}\n\nbool Context::release(bool fast) {\n if (fast) {\n return_stack.forget();\n expr_stack.forget();\n return true;\n }\n\n bool result = true;\n if (!return_stack.release()) {\n result = false;\n }\n if (!expr_stack.release()) {\n result = false;\n }\n return result;\n}\n\nvoid Context::do_trace(HeapMarkState * state) const\n{\n /*\n * The +1 is required here because the callee will only mark the first N\n * bytes in these memory areas, and esp and rsp are zero-based indexes,\n * So if esp is 2, which means the 3rd (0-based) index is the\n * top-of-stack. Then we need (2+1)*sizeof(...) to ensure we mark all\n * three items.\n */\n state->mark_root_conservative((void*)expr_stack.ptr(),\n (esp + 1) * sizeof(StackValue));\n state->mark_root_conservative_interior((void*)return_stack.ptr(),\n (rsp + 1) * WORDSIZE_BYTES);\n state->mark_root_interior(ip);\n state->mark_root(env);\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_generic_builder.cpp", "content": "/*\n * Plasma bytecode memory representation builder\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n\n#include \"pz_data.h\"\n#include \"pz_format.h\"\n#include \"pz_gc.h\"\n#include \"pz_instructions.h\"\n#include \"pz_util.h\"\n\n#include \"pz_generic_run.h\"\n\n// Clang format doesn't do a great job on this file\n// clang-format off\n\nnamespace pz {\n\nstatic unsigned write_opcode(uint8_t * proc, unsigned offset,\n InstructionToken token);\n\nstatic unsigned write_immediate(uint8_t * proc, unsigned offset,\n ImmediateType imm_type,\n ImmediateValue imm_value);\n\n/*\n * Instruction and intermedate data sizes, and procedures to write them.\n *\n *********************/\n\nstatic unsigned immediate_size(ImmediateType imt)\n{\n switch (imt) {\n case IMT_NONE:\n return 0;\n case IMT_8:\n return 1;\n case IMT_16:\n case IMT_STRUCT_REF_FIELD:\n return 2;\n case IMT_32:\n return 4;\n case IMT_64:\n return 8;\n case IMT_CLOSURE_REF:\n case IMT_PROC_REF:\n case IMT_IMPORT_CLOSURE_REF:\n case IMT_STRUCT_REF:\n case IMT_LABEL_REF:\n return WORDSIZE_BYTES;\n }\n abort();\n}\n\n#define SELECT_IMMEDIATE(type, value, result) \\\n switch (type) { \\\n case IMT_8: \\\n (result) = (value).uint8; \\\n break; \\\n case IMT_16: \\\n (result) = (value).uint16; \\\n break; \\\n case IMT_32: \\\n (result) = (value).uint32; \\\n break; \\\n case IMT_64: \\\n (result) = (value).uint64; \\\n break; \\\n default: \\\n fprintf(stderr, \\\n \"Invalid immediate value for laod immediate number\"); \\\n abort(); \\\n }\n\nunsigned write_instr(uint8_t * proc, unsigned offset, PZ_Opcode opcode)\n{\n#define PZ_WRITE_INSTR_0(code, tok) \\\n if (opcode == (code)) { \\\n return write_opcode(proc, offset, tok); \\\n }\n\n assert(0 == instruction_info[opcode].ii_num_width_bytes);\n assert(IMT_NONE == instruction_info[opcode].ii_immediate_type);\n\n PZ_WRITE_INSTR_0(PZI_DROP, PZT_DROP);\n\n PZ_WRITE_INSTR_0(PZI_CALL_IND, PZT_CALL_IND);\n PZ_WRITE_INSTR_0(PZI_TCALL_IND, PZT_TCALL_IND);\n PZ_WRITE_INSTR_0(PZI_RET, PZT_RET);\n\n PZ_WRITE_INSTR_0(PZI_GET_ENV, PZT_GET_ENV);\n\n PZ_WRITE_INSTR_0(PZI_END, PZT_END);\n\n#undef PZ_WRITE_INSTR_0\n\n fprintf(stderr, \"Bad or unimplemented instruction\\n\");\n abort();\n}\n\nunsigned write_instr(uint8_t * proc, unsigned offset, PZ_Opcode opcode,\n ImmediateType imm_type, ImmediateValue imm_value)\n{\n#define PZ_WRITE_INSTR_0(code, tok) \\\n if (opcode == (code)) { \\\n offset = write_opcode(proc, offset, tok); \\\n offset = write_immediate(proc, offset, imm_type, imm_value); \\\n return offset; \\\n }\n\n assert(0 == instruction_info[opcode].ii_num_width_bytes);\n assert(IMT_NONE != instruction_info[opcode].ii_immediate_type);\n\n if ((opcode == PZI_ROLL) && (imm_type == IMT_8) && (imm_value.uint8 == 2)) {\n /* Optimize roll 2 into swap */\n return write_opcode(proc, offset, PZT_SWAP);\n }\n PZ_WRITE_INSTR_0(PZI_ROLL, PZT_ROLL);\n\n if ((opcode == PZI_PICK) && (imm_type == IMT_8) && (imm_value.uint8 == 1)) {\n /* Optimize pick 1 into dup */\n return write_opcode(proc, offset, PZT_DUP);\n }\n PZ_WRITE_INSTR_0(PZI_PICK, PZT_PICK);\n\n PZ_WRITE_INSTR_0(PZI_CALL, PZT_CALL);\n PZ_WRITE_INSTR_0(PZI_CALL_IMPORT, PZT_CALL);\n\n PZ_WRITE_INSTR_0(PZI_CALL_PROC, PZT_CALL_PROC);\n\n PZ_WRITE_INSTR_0(PZI_TCALL, PZT_TCALL);\n\n PZ_WRITE_INSTR_0(PZI_TCALL_PROC, PZT_TCALL_PROC);\n\n PZ_WRITE_INSTR_0(PZI_JMP, PZT_JMP);\n\n PZ_WRITE_INSTR_0(PZI_ALLOC, PZT_ALLOC);\n PZ_WRITE_INSTR_0(PZI_MAKE_CLOSURE, PZT_MAKE_CLOSURE);\n\n PZ_WRITE_INSTR_0(PZI_CCALL, PZT_CCALL);\n PZ_WRITE_INSTR_0(PZI_CCALL_ALLOC, PZT_CCALL_ALLOC);\n PZ_WRITE_INSTR_0(PZI_CCALL_SPECIAL, PZT_CCALL_SPECIAL);\n\n#undef PZ_WRITE_INSTR_0\n\n fprintf(stderr, \"Bad or unimplemented instruction\\n\");\n abort();\n}\n\nunsigned\nwrite_instr(uint8_t * proc,\n unsigned offset,\n PZ_Opcode opcode,\n PZ_Width width1)\n{\n width1 = width_normalize(width1);\n\n#define PZ_WRITE_INSTR_1(code, w1, tok) \\\n if (opcode == (code) && width1 == (w1)) { \\\n return write_opcode(proc, offset, tok); \\\n }\n\n assert(1 == instruction_info[opcode].ii_num_width_bytes);\n assert(IMT_NONE == instruction_info[opcode].ii_immediate_type);\n\n PZ_WRITE_INSTR_1(PZI_ADD, PZW_8, PZT_ADD_8);\n PZ_WRITE_INSTR_1(PZI_ADD, PZW_16, PZT_ADD_16);\n PZ_WRITE_INSTR_1(PZI_ADD, PZW_32, PZT_ADD_32);\n PZ_WRITE_INSTR_1(PZI_ADD, PZW_64, PZT_ADD_64);\n\n PZ_WRITE_INSTR_1(PZI_SUB, PZW_8, PZT_SUB_8);\n PZ_WRITE_INSTR_1(PZI_SUB, PZW_16, PZT_SUB_16);\n PZ_WRITE_INSTR_1(PZI_SUB, PZW_32, PZT_SUB_32);\n PZ_WRITE_INSTR_1(PZI_SUB, PZW_64, PZT_SUB_64);\n\n PZ_WRITE_INSTR_1(PZI_MUL, PZW_8, PZT_MUL_8);\n PZ_WRITE_INSTR_1(PZI_MUL, PZW_16, PZT_MUL_16);\n PZ_WRITE_INSTR_1(PZI_MUL, PZW_32, PZT_MUL_32);\n PZ_WRITE_INSTR_1(PZI_MUL, PZW_64, PZT_MUL_64);\n\n PZ_WRITE_INSTR_1(PZI_DIV, PZW_8, PZT_DIV_8);\n PZ_WRITE_INSTR_1(PZI_DIV, PZW_16, PZT_DIV_16);\n PZ_WRITE_INSTR_1(PZI_DIV, PZW_32, PZT_DIV_32);\n PZ_WRITE_INSTR_1(PZI_DIV, PZW_64, PZT_DIV_64);\n\n PZ_WRITE_INSTR_1(PZI_MOD, PZW_8, PZT_MOD_8);\n PZ_WRITE_INSTR_1(PZI_MOD, PZW_16, PZT_MOD_16);\n PZ_WRITE_INSTR_1(PZI_MOD, PZW_32, PZT_MOD_32);\n PZ_WRITE_INSTR_1(PZI_MOD, PZW_64, PZT_MOD_64);\n\n PZ_WRITE_INSTR_1(PZI_LSHIFT, PZW_8, PZT_LSHIFT_8);\n PZ_WRITE_INSTR_1(PZI_LSHIFT, PZW_16, PZT_LSHIFT_16);\n PZ_WRITE_INSTR_1(PZI_LSHIFT, PZW_32, PZT_LSHIFT_32);\n PZ_WRITE_INSTR_1(PZI_LSHIFT, PZW_64, PZT_LSHIFT_64);\n\n PZ_WRITE_INSTR_1(PZI_RSHIFT, PZW_8, PZT_RSHIFT_8);\n PZ_WRITE_INSTR_1(PZI_RSHIFT, PZW_16, PZT_RSHIFT_16);\n PZ_WRITE_INSTR_1(PZI_RSHIFT, PZW_32, PZT_RSHIFT_32);\n PZ_WRITE_INSTR_1(PZI_RSHIFT, PZW_64, PZT_RSHIFT_64);\n\n PZ_WRITE_INSTR_1(PZI_AND, PZW_8, PZT_AND_8);\n PZ_WRITE_INSTR_1(PZI_AND, PZW_16, PZT_AND_16);\n PZ_WRITE_INSTR_1(PZI_AND, PZW_32, PZT_AND_32);\n PZ_WRITE_INSTR_1(PZI_AND, PZW_64, PZT_AND_64);\n\n PZ_WRITE_INSTR_1(PZI_OR, PZW_8, PZT_OR_8);\n PZ_WRITE_INSTR_1(PZI_OR, PZW_16, PZT_OR_16);\n PZ_WRITE_INSTR_1(PZI_OR, PZW_32, PZT_OR_32);\n PZ_WRITE_INSTR_1(PZI_OR, PZW_64, PZT_OR_64);\n\n PZ_WRITE_INSTR_1(PZI_XOR, PZW_8, PZT_XOR_8);\n PZ_WRITE_INSTR_1(PZI_XOR, PZW_16, PZT_XOR_16);\n PZ_WRITE_INSTR_1(PZI_XOR, PZW_32, PZT_XOR_32);\n PZ_WRITE_INSTR_1(PZI_XOR, PZW_64, PZT_XOR_64);\n\n PZ_WRITE_INSTR_1(PZI_LT_U, PZW_8, PZT_LT_U_8);\n PZ_WRITE_INSTR_1(PZI_LT_U, PZW_16, PZT_LT_U_16);\n PZ_WRITE_INSTR_1(PZI_LT_U, PZW_32, PZT_LT_U_32);\n PZ_WRITE_INSTR_1(PZI_LT_U, PZW_64, PZT_LT_U_64);\n\n PZ_WRITE_INSTR_1(PZI_LT_S, PZW_8, PZT_LT_S_8);\n PZ_WRITE_INSTR_1(PZI_LT_S, PZW_16, PZT_LT_S_16);\n PZ_WRITE_INSTR_1(PZI_LT_S, PZW_32, PZT_LT_S_32);\n PZ_WRITE_INSTR_1(PZI_LT_S, PZW_64, PZT_LT_S_64);\n\n PZ_WRITE_INSTR_1(PZI_GT_U, PZW_8, PZT_GT_U_8);\n PZ_WRITE_INSTR_1(PZI_GT_U, PZW_16, PZT_GT_U_16);\n PZ_WRITE_INSTR_1(PZI_GT_U, PZW_32, PZT_GT_U_32);\n PZ_WRITE_INSTR_1(PZI_GT_U, PZW_64, PZT_GT_U_64);\n\n PZ_WRITE_INSTR_1(PZI_GT_S, PZW_8, PZT_GT_S_8);\n PZ_WRITE_INSTR_1(PZI_GT_S, PZW_16, PZT_GT_S_16);\n PZ_WRITE_INSTR_1(PZI_GT_S, PZW_32, PZT_GT_S_32);\n PZ_WRITE_INSTR_1(PZI_GT_S, PZW_64, PZT_GT_S_64);\n\n PZ_WRITE_INSTR_1(PZI_EQ, PZW_8, PZT_EQ_8);\n PZ_WRITE_INSTR_1(PZI_EQ, PZW_16, PZT_EQ_16);\n PZ_WRITE_INSTR_1(PZI_EQ, PZW_32, PZT_EQ_32);\n PZ_WRITE_INSTR_1(PZI_EQ, PZW_64, PZT_EQ_64);\n\n PZ_WRITE_INSTR_1(PZI_NOT, PZW_8, PZT_NOT_8);\n PZ_WRITE_INSTR_1(PZI_NOT, PZW_16, PZT_NOT_16);\n PZ_WRITE_INSTR_1(PZI_NOT, PZW_32, PZT_NOT_32);\n PZ_WRITE_INSTR_1(PZI_NOT, PZW_64, PZT_NOT_64);\n\n#undef PZ_WRITE_INSTR_1\n\n fprintf(stderr, \"Bad or unimplemented instruction\\n\");\n abort();\n}\n\nunsigned\nwrite_instr(uint8_t *proc,\n unsigned offset,\n PZ_Opcode opcode,\n PZ_Width width1,\n ImmediateType imm_type,\n ImmediateValue imm_value)\n{\n width1 = width_normalize(width1);\n\n#define PZ_WRITE_INSTR_1(code, w1, tok) \\\n if (opcode == (code) && width1 == (w1)) { \\\n offset = write_opcode(proc, offset, tok); \\\n offset = write_immediate(proc, offset, imm_type, imm_value); \\\n return offset; \\\n }\n\n assert(1 == instruction_info[opcode].ii_num_width_bytes);\n assert(IMT_NONE != instruction_info[opcode].ii_immediate_type);\n\n if (opcode == PZI_LOAD_IMMEDIATE_NUM) {\n switch (width1) {\n case PZW_8:\n SELECT_IMMEDIATE(imm_type, imm_value, imm_value.uint8);\n offset = write_opcode(proc, offset, PZT_LOAD_IMMEDIATE_8);\n offset = write_immediate(proc, offset, IMT_8, imm_value);\n return offset;\n case PZW_16:\n SELECT_IMMEDIATE(imm_type, imm_value, imm_value.uint16);\n offset = write_opcode(proc, offset, PZT_LOAD_IMMEDIATE_16);\n offset = write_immediate(proc, offset, IMT_16, imm_value);\n return offset;\n case PZW_32:\n SELECT_IMMEDIATE(imm_type, imm_value, imm_value.uint32);\n offset = write_opcode(proc, offset, PZT_LOAD_IMMEDIATE_32);\n offset = write_immediate(proc, offset, IMT_32, imm_value);\n return offset;\n case PZW_64:\n SELECT_IMMEDIATE(imm_type, imm_value, imm_value.uint64);\n offset = write_opcode(proc, offset, PZT_LOAD_IMMEDIATE_64);\n offset = write_immediate(proc, offset, IMT_64, imm_value);\n return offset;\n default:\n goto error;\n }\n }\n\n PZ_WRITE_INSTR_1(PZI_CJMP, PZW_8, PZT_CJMP_8);\n PZ_WRITE_INSTR_1(PZI_CJMP, PZW_16, PZT_CJMP_16);\n PZ_WRITE_INSTR_1(PZI_CJMP, PZW_32, PZT_CJMP_32);\n PZ_WRITE_INSTR_1(PZI_CJMP, PZW_64, PZT_CJMP_64);\n\n PZ_WRITE_INSTR_1(PZI_LOAD, PZW_8, PZT_LOAD_8);\n PZ_WRITE_INSTR_1(PZI_LOAD, PZW_16, PZT_LOAD_16);\n PZ_WRITE_INSTR_1(PZI_LOAD, PZW_32, PZT_LOAD_32);\n PZ_WRITE_INSTR_1(PZI_LOAD, PZW_64, PZT_LOAD_64);\n PZ_WRITE_INSTR_1(PZI_STORE, PZW_8, PZT_STORE_8);\n PZ_WRITE_INSTR_1(PZI_STORE, PZW_16, PZT_STORE_16);\n PZ_WRITE_INSTR_1(PZI_STORE, PZW_32, PZT_STORE_32);\n PZ_WRITE_INSTR_1(PZI_STORE, PZW_64, PZT_STORE_64);\n\n#undef PZ_WRITE_INSTR_1\n\nerror:\n fprintf(stderr, \"Bad or unimplemented instruction\\n\");\n abort();\n}\n\nunsigned\nwrite_instr(uint8_t * proc,\n unsigned offset,\n PZ_Opcode opcode,\n PZ_Width width1,\n PZ_Width width2)\n{\n InstructionToken token;\n\n width1 = width_normalize(width1);\n width2 = width_normalize(width2);\n\n#define PZ_WRITE_INSTR_2(code, w1, w2, tok) \\\n if (opcode == (code) && width1 == (w1) && width2 == (w2)) { \\\n token = (tok); \\\n return write_opcode(proc, offset, token); \\\n }\n\n assert(2 == instruction_info[opcode].ii_num_width_bytes);\n assert(IMT_NONE == instruction_info[opcode].ii_immediate_type);\n\n PZ_WRITE_INSTR_2(PZI_ZE, PZW_8, PZW_8, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_ZE, PZW_8, PZW_16, PZT_ZE_8_16);\n PZ_WRITE_INSTR_2(PZI_ZE, PZW_8, PZW_32, PZT_ZE_8_32);\n PZ_WRITE_INSTR_2(PZI_ZE, PZW_8, PZW_64, PZT_ZE_8_64);\n PZ_WRITE_INSTR_2(PZI_ZE, PZW_16, PZW_16, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_ZE, PZW_16, PZW_32, PZT_ZE_16_32);\n PZ_WRITE_INSTR_2(PZI_ZE, PZW_16, PZW_64, PZT_ZE_16_64);\n PZ_WRITE_INSTR_2(PZI_ZE, PZW_32, PZW_32, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_ZE, PZW_32, PZW_64, PZT_ZE_32_64);\n\n PZ_WRITE_INSTR_2(PZI_SE, PZW_8, PZW_8, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_SE, PZW_8, PZW_16, PZT_SE_8_16);\n PZ_WRITE_INSTR_2(PZI_SE, PZW_8, PZW_32, PZT_SE_8_32);\n PZ_WRITE_INSTR_2(PZI_SE, PZW_8, PZW_64, PZT_SE_8_64);\n PZ_WRITE_INSTR_2(PZI_SE, PZW_16, PZW_16, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_SE, PZW_16, PZW_32, PZT_SE_16_32);\n PZ_WRITE_INSTR_2(PZI_SE, PZW_16, PZW_64, PZT_SE_16_64);\n PZ_WRITE_INSTR_2(PZI_SE, PZW_32, PZW_32, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_SE, PZW_32, PZW_64, PZT_SE_32_64);\n\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_8, PZW_8, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_16, PZW_16, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_16, PZW_8, PZT_TRUNC_16_8);\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_32, PZW_32, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_32, PZW_16, PZT_TRUNC_32_16);\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_32, PZW_8, PZT_TRUNC_32_8);\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_64, PZW_64, PZT_NOP);\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_64, PZW_32, PZT_TRUNC_64_32);\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_64, PZW_16, PZT_TRUNC_64_16);\n PZ_WRITE_INSTR_2(PZI_TRUNC, PZW_64, PZW_8, PZT_TRUNC_64_8);\n\n#undef PZ_WRITE_INSTR_2\n\n fprintf(stderr, \"Bad or unimplemented instruction\\n\");\n abort();\n}\n\nstatic unsigned\nwrite_opcode(uint8_t *proc,\n unsigned offset,\n InstructionToken token)\n{\n if (proc != nullptr) {\n *((uint8_t *)(&proc[offset])) = token;\n }\n offset += 1;\n return offset;\n}\n\nstatic unsigned\nwrite_immediate(uint8_t *proc,\n unsigned offset,\n ImmediateType imm_type,\n ImmediateValue imm_value)\n{\n assert(imm_type != IMT_NONE);\n\n unsigned imm_size = immediate_size(imm_type);\n unsigned new_offset = AlignUp(offset, imm_size);\n if (proc) {\n /*\n * Zero-fill alignment padding for readability in debugging.\n * but also do this in non-dev builds.\n */\n while (offset < new_offset) {\n proc[offset++] = 0;\n }\n } else {\n offset = new_offset;\n }\n\n if (proc != nullptr) {\n switch (imm_type) {\n case IMT_NONE:\n break;\n case IMT_8:\n *((uint8_t *)(&proc[offset])) = imm_value.uint8;\n break;\n case IMT_16:\n case IMT_STRUCT_REF_FIELD:\n *((uint16_t *)(&proc[offset])) = imm_value.uint16;\n break;\n case IMT_32:\n *((uint32_t *)(&proc[offset])) = imm_value.uint32;\n break;\n case IMT_64:\n *((uint64_t *)(&proc[offset])) = imm_value.uint64;\n break;\n case IMT_CLOSURE_REF:\n case IMT_PROC_REF:\n case IMT_IMPORT_CLOSURE_REF:\n case IMT_STRUCT_REF:\n case IMT_LABEL_REF:\n *((uintptr_t *)(&proc[offset])) = imm_value.word;\n break;\n }\n }\n\n offset += imm_size;\n\n return offset;\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_generic_builtin.cpp", "content": "/*\n * Plasma bytecode exection (generic portable version)\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n#include \n#include \n#include \n\n#include \"pz_interp.h\"\n\n#include \"pz_gc.h\"\n#include \"pz_generic_run.h\"\n#include \"pz_string.h\"\n\nnamespace pz {\n\ntemplate\nstatic\nuintptr_t Box(T v, GCCapability &gc) {\n T *ptr = reinterpret_cast(gc.alloc_bytes(sizeof(T)));\n *ptr = v;\n return reinterpret_cast(ptr);\n}\n\n/*\n * Imported procedures\n *\n **********************/\n\nunsigned pz_builtin_print_func(void * void_stack, unsigned sp)\n{\n StackValue * stack = static_cast(void_stack);\n\n String::from_ptr(stack[sp--].ptr).print();\n\n return sp;\n}\n\nunsigned pz_builtin_readline_func(void * void_stack, unsigned sp,\n AbstractGCTracer & gc_trace)\n{\n const uint32_t READLINE_BUFFER_SIZE = 128;\n StackValue * stack = static_cast(void_stack);\n NoGCScope nogc(gc_trace);\n bool got_eof = false;\n\n String str(\"\");\n do {\n FlatString *fs = FlatString::New(nogc, READLINE_BUFFER_SIZE);\n char *res = fgets(fs->buffer(), READLINE_BUFFER_SIZE, stdin);\n if (!res) {\n if (ferror(stdin)) {\n perror(\"stdin\");\n exit(PZ_EXIT_RUNTIME_ERROR);\n } else if (feof(stdin)) {\n got_eof = true;\n break;\n }\n // unreachable\n assert(false);\n }\n\n int read_len = strlen(fs->buffer());\n if (read_len == 0) {\n // We don't need to process an empty string.\n break;\n }\n\n fs->fixSize(strlen(fs->buffer()));\n if (fs->length() > 0 && fs->buffer()[fs->length()-1] == '\\n') {\n // Remove the newline character\n // TODO: If string had a way to set chars then we can simplify\n // this by doing the operation on string and having a single\n // call to append.\n fs->buffer()[fs->length()-1] = 0;\n fs->fixSize(fs->length()-1);\n str = String::append(nogc, str, String(fs));\n break;\n }\n str = String::append(nogc, str, String(fs));\n if (fs->length() != (READLINE_BUFFER_SIZE - 1)) {\n break;\n }\n } while(true);\n\n nogc.abort_if_oom(\"reading stdin\");\n\n sp++;\n if (got_eof && str.isEmpty()) {\n stack[sp].uptr = 0;\n return sp;\n }\n\n // Tag the pointer for the Ok constructor.\n stack[sp].uptr = Box(str.ptr(), nogc) | 1;\n return sp;\n}\n\n/*\n * Long enough for a 32 bit value, plus a sign, plus a null termination\n * byte.\n */\n#define INT_TO_STRING_BUFFER_SIZE 11\n\nunsigned pz_builtin_int_to_string_func(void * void_stack, unsigned sp,\n AbstractGCTracer & gc_trace)\n{\n StackValue * stack = static_cast(void_stack);\n int32_t num = stack[sp].s32;\n\n FlatString * string = FlatString::New(gc_trace, INT_TO_STRING_BUFFER_SIZE);\n int result = snprintf(string->buffer(),\n INT_TO_STRING_BUFFER_SIZE, \"%d\", (int)num);\n if ((result < 0) || (result > (INT_TO_STRING_BUFFER_SIZE - 1))) {\n stack[sp].ptr = NULL;\n } else {\n string->fixSize(result);\n stack[sp].ptr = string;\n }\n return sp;\n}\n\nunsigned pz_builtin_setenv_func(void * void_stack, unsigned sp)\n{\n StackValue * stack = static_cast(void_stack);\n const String value = String::from_ptr(stack[sp--].ptr);\n const String name = String::from_ptr(stack[sp--].ptr);\n\n int result = setenv(name.c_str(), value.c_str(), 1);\n\n stack[++sp].u32 = !result;\n\n return sp;\n}\n\nunsigned pz_builtin_gettimeofday_func(void * void_stack, unsigned sp)\n{\n StackValue * stack = static_cast(void_stack);\n\n struct timeval tv;\n int res = gettimeofday(&tv, NULL);\n\n stack[++sp].u32 = res == 0 ? 1 : 0;\n // This is aweful, but Plasma itself doesn't handle other inttypes yet.\n stack[++sp].u32 = (uint32_t)tv.tv_sec;\n stack[++sp].u32 = (uint32_t)tv.tv_usec;\n\n return sp;\n}\n\nunsigned pz_builtin_string_concat_func(void * void_stack, unsigned sp,\n AbstractGCTracer & gc_trace)\n{\n StackValue * stack = static_cast(void_stack);\n\n const String s2 = String::from_ptr(stack[sp--].ptr);\n const String s1 = String::from_ptr(stack[sp].ptr);\n String s = String::append(gc_trace, s1, s2);\n\n stack[sp].ptr = s.ptr();\n return sp;\n}\n\nunsigned pz_builtin_die_func(void * void_stack, unsigned sp)\n{\n StackValue * stack = static_cast(void_stack);\n const String s = String::from_ptr(stack[sp].ptr);\n fprintf(stderr, \"Die: %s\\n\", s.c_str());\n exit(1);\n}\n\nunsigned pz_builtin_set_parameter_func(void * void_stack, unsigned sp, PZ & pz)\n{\n StackValue * stack = static_cast(void_stack);\n\n // int32_t value = stack[sp].s32;\n const String name = String::from_ptr(stack[sp - 1].ptr);\n\n /*\n * There are no parameters defined.\n */\n fprintf(stderr, \"No such parameter '%s'\\n\", name.c_str());\n int32_t result = 0;\n\n sp--;\n stack[sp].sptr = result;\n\n return sp;\n}\n\nunsigned pz_builtin_get_parameter_func(void * void_stack, unsigned sp, PZ & pz)\n{\n StackValue * stack = static_cast(void_stack);\n\n const String name = String::from_ptr(stack[sp].ptr);\n\n int32_t result;\n int32_t value;\n if (name.equals(String(\"heap_usage\"))) {\n value = heap_get_usage(&pz.heap());\n result = 1;\n } else if (name.equals(String(\"heap_collections\"))) {\n value = heap_get_collections(&pz.heap());\n result = 1;\n } else {\n fprintf(stderr, \"No such parameter '%s'.\\n\", name.c_str());\n result = 0;\n value = 0;\n }\n\n stack[sp].sptr = result;\n stack[sp + 1].sptr = value;\n sp++;\n\n return sp;\n}\n\nunsigned pz_builtin_codepoint_category(void * void_stack, unsigned sp)\n{\n // TODO use a unicode library. While POSIX is locale-aware it does not\n // handle characters outside the current locale, but applications may\n // use more than a single langauge at a time.\n \n StackValue * stack = static_cast(void_stack);\n\n CodePoint32 c = stack[sp].u32;\n // TODO: Use a proper FFI so we don't need to guess type tags.\n stack[sp].uptr = isspace(c) ? 0 : 1;\n\n return sp;\n}\n\nunsigned pz_builtin_codepoint_to_string(void * void_stack, unsigned sp,\n AbstractGCTracer & gc)\n{\n StackValue * stack = static_cast(void_stack);\n\n CodePoint32 c = stack[sp].u32;\n FlatString *fs = FlatString::New(gc, 1);\n if (c > CHAR_MAX) {\n fprintf(stderr, \"Unicode not supported yet\\n\");\n abort();\n }\n fs->buffer()[0] = c;\n stack[sp].ptr = String(fs).ptr(); \n\n return sp;\n}\n\nunsigned pz_builtin_strpos_forward(void * void_stack, unsigned sp,\n AbstractGCTracer &gc)\n{\n StackValue * stack = static_cast(void_stack);\n\n const StringPos* pos = reinterpret_cast(stack[sp].ptr);\n stack[sp].ptr = pos->forward(gc);\n\n return sp;\n}\n\nunsigned pz_builtin_strpos_backward(void * void_stack, unsigned sp,\n AbstractGCTracer &gc)\n{\n StackValue * stack = static_cast(void_stack);\n\n const StringPos* pos = reinterpret_cast(stack[sp].ptr);\n stack[sp].ptr = pos->backward(gc);\n\n return sp;\n}\n\nunsigned pz_builtin_strpos_next_char(void * void_stack, unsigned sp,\n AbstractGCTracer & gc)\n{\n StackValue * stack = static_cast(void_stack);\n\n const StringPos* pos = reinterpret_cast(stack[sp].ptr);\n // XXX add pointer tagging macros.\n if (pos->at_end()) {\n stack[sp].uptr = 0;\n } else {\n stack[sp].uptr = Box(pos->next_char(), gc) | 1;\n }\n\n return sp;\n}\n\nunsigned pz_builtin_strpos_prev_char(void * void_stack, unsigned sp,\n AbstractGCTracer & gc)\n{\n StackValue * stack = static_cast(void_stack);\n\n const StringPos* pos = reinterpret_cast(stack[sp].ptr);\n if (pos->at_beginning()) {\n stack[sp].uptr = 0;\n } else {\n stack[sp].uptr = Box(pos->prev_char(), gc) | 1;\n }\n\n return sp;\n}\n\nunsigned pz_builtin_string_begin(void * void_stack, unsigned sp,\n AbstractGCTracer & gc)\n{\n StackValue * stack = static_cast(void_stack);\n\n const String string = String::from_ptr(stack[sp].ptr);\n stack[sp].ptr = string.begin(gc);\n\n return sp;\n}\n\nunsigned pz_builtin_string_end(void * void_stack, unsigned sp,\n AbstractGCTracer & gc)\n{\n StackValue * stack = static_cast(void_stack);\n\n const String string = String::from_ptr(stack[sp].ptr);\n stack[sp].ptr = string.end(gc);\n\n return sp;\n}\n\nunsigned pz_builtin_string_substring(void * void_stack, unsigned sp,\n AbstractGCTracer & gc)\n{\n StackValue * stack = static_cast(void_stack);\n\n const StringPos* pos2 = reinterpret_cast(stack[sp--].ptr);\n const StringPos* pos1 = reinterpret_cast(stack[sp].ptr);\n const String str = String::substring(gc, pos1, pos2);\n stack[sp].ptr = str.ptr();\n\n return sp;\n}\n\nunsigned pz_builtin_string_equals(void * void_stack, unsigned sp) {\n StackValue * stack = static_cast(void_stack);\n\n const String str1 = String::from_ptr(stack[sp--].ptr);\n const String str2 = String::from_ptr(stack[sp].ptr);\n\n stack[sp].uptr = str1.equals(str2);\n\n return sp;\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_generic_closure.cpp", "content": "/*\n * Plasma closures\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \"pz_closure.h\"\n#include \"pz_generic_closure.h\"\n\nnamespace pz {\n\n} // namespace pz\n" }, { "path": "runtime/pz_generic_closure.h", "content": "/*\n * Plasma closures\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_GENERIC_CLOSURE_H\n#define PZ_GENERIC_CLOSURE_H\n\n#include \"pz_gc_util.h\"\n\nnamespace pz {\n\nclass Closure : public GCNew\n{\n private:\n void * m_code;\n void * m_data;\n\n public:\n Closure() : m_code(nullptr), m_data(nullptr) {}\n\n Closure(void * code, void * data) : m_code(code), m_data(data) {}\n\n void init(void * code, void * data)\n {\n assert(!m_code);\n m_code = code;\n m_data = data;\n }\n\n void * code() const\n {\n return m_code;\n }\n void * data() const\n {\n return m_data;\n }\n};\n\n} // namespace pz\n\n#endif // !PZ_GENERIC_CLOSURE_H\n" }, { "path": "runtime/pz_generic_run.cpp", "content": "/*\n * Plasma bytecode exection (generic portable version)\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \"pz_gc.h\"\n#include \"pz_interp.h\"\n#include \"pz_trace.h\"\n#include \"pz_util.h\"\n\n#include \n\n#include \"pz_generic_closure.h\"\n#include \"pz_generic_run.h\"\n\nnamespace pz {\n\nint generic_main_loop(Context & context, Heap * heap, Closure * closure,\n PZ & pz)\n{\n int retcode;\n context.ip = static_cast(closure->code());\n context.env = closure->data();\n\n pz_trace_state(heap,\n context.ip,\n context.env,\n context.rsp,\n context.esp,\n (uint64_t *)context.expr_stack.ptr());\n while (true) {\n InstructionToken token = (InstructionToken)(*(context.ip));\n\n context.ip++;\n switch (token) {\n case PZT_NOP:\n pz_trace_instr(context.rsp, \"nop\");\n break;\n case PZT_LOAD_IMMEDIATE_8:\n context.expr_stack[++context.esp].u8 = *context.ip;\n context.ip++;\n pz_trace_instr(context.rsp, \"load imm:8\");\n break;\n case PZT_LOAD_IMMEDIATE_16:\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n context.expr_stack[++context.esp].u16 = *(uint16_t *)context.ip;\n context.ip += 2;\n pz_trace_instr(context.rsp, \"load imm:16\");\n break;\n case PZT_LOAD_IMMEDIATE_32:\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 4);\n context.expr_stack[++context.esp].u32 = *(uint32_t *)context.ip;\n context.ip += 4;\n pz_trace_instr(context.rsp, \"load imm:32\");\n break;\n case PZT_LOAD_IMMEDIATE_64:\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 8);\n context.expr_stack[++context.esp].u64 = *(uint64_t *)context.ip;\n context.ip += 8;\n pz_trace_instr(context.rsp, \"load imm:64\");\n break;\n case PZT_ZE_8_16:\n context.expr_stack[context.esp].u16 =\n context.expr_stack[context.esp].u8;\n pz_trace_instr(context.rsp, \"ze:8:16\");\n break;\n case PZT_ZE_8_32:\n context.expr_stack[context.esp].u32 =\n context.expr_stack[context.esp].u8;\n pz_trace_instr(context.rsp, \"ze:8:32\");\n break;\n case PZT_ZE_8_64:\n context.expr_stack[context.esp].u64 =\n context.expr_stack[context.esp].u8;\n pz_trace_instr(context.rsp, \"ze:8:64\");\n break;\n case PZT_ZE_16_32:\n context.expr_stack[context.esp].u32 =\n context.expr_stack[context.esp].u16;\n pz_trace_instr(context.rsp, \"ze:16:32\");\n break;\n case PZT_ZE_16_64:\n context.expr_stack[context.esp].u64 =\n context.expr_stack[context.esp].u16;\n pz_trace_instr(context.rsp, \"ze:16:64\");\n break;\n case PZT_ZE_32_64:\n context.expr_stack[context.esp].u64 =\n context.expr_stack[context.esp].u32;\n pz_trace_instr(context.rsp, \"ze:32:64\");\n break;\n case PZT_SE_8_16:\n context.expr_stack[context.esp].s16 =\n context.expr_stack[context.esp].s8;\n pz_trace_instr(context.rsp, \"se:8:16\");\n break;\n case PZT_SE_8_32:\n context.expr_stack[context.esp].s32 =\n context.expr_stack[context.esp].s8;\n pz_trace_instr(context.rsp, \"se:8:32\");\n break;\n case PZT_SE_8_64:\n context.expr_stack[context.esp].s64 =\n context.expr_stack[context.esp].s8;\n pz_trace_instr(context.rsp, \"se:8:64\");\n break;\n case PZT_SE_16_32:\n context.expr_stack[context.esp].s32 =\n context.expr_stack[context.esp].s16;\n pz_trace_instr(context.rsp, \"se:16:32\");\n break;\n case PZT_SE_16_64:\n context.expr_stack[context.esp].s64 =\n context.expr_stack[context.esp].s16;\n pz_trace_instr(context.rsp, \"se:16:64\");\n break;\n case PZT_SE_32_64:\n context.expr_stack[context.esp].s64 =\n context.expr_stack[context.esp].s32;\n pz_trace_instr(context.rsp, \"se:32:64\");\n break;\n case PZT_TRUNC_64_32:\n context.expr_stack[context.esp].u32 =\n context.expr_stack[context.esp].u64 & 0xFFFFFFFFu;\n pz_trace_instr(context.rsp, \"trunc:64:32\");\n break;\n case PZT_TRUNC_64_16:\n context.expr_stack[context.esp].u16 =\n context.expr_stack[context.esp].u64 & 0xFFFF;\n pz_trace_instr(context.rsp, \"trunc:64:16\");\n break;\n case PZT_TRUNC_64_8:\n context.expr_stack[context.esp].u8 =\n context.expr_stack[context.esp].u64 & 0xFF;\n pz_trace_instr(context.rsp, \"trunc:64:8\");\n break;\n case PZT_TRUNC_32_16:\n context.expr_stack[context.esp].u16 =\n context.expr_stack[context.esp].u32 & 0xFFFF;\n pz_trace_instr(context.rsp, \"trunc:32:16\");\n break;\n case PZT_TRUNC_32_8:\n context.expr_stack[context.esp].u8 =\n context.expr_stack[context.esp].u32 & 0xFF;\n pz_trace_instr(context.rsp, \"trunc:32:8\");\n break;\n case PZT_TRUNC_16_8:\n context.expr_stack[context.esp].u8 =\n context.expr_stack[context.esp].u16 & 0xFF;\n pz_trace_instr(context.rsp, \"trunc:16:8\");\n break;\n\n#define PZ_RUN_ARITHMETIC(opcode_base, width, signedness, operator, op_name) \\\n case opcode_base##_##width: \\\n context.expr_stack[context.esp - 1].signedness##width = \\\n (context.expr_stack[context.esp - 1] \\\n .signedness##width \\\n operator context.expr_stack[context.esp] \\\n .signedness##width); \\\n context.esp--; \\\n pz_trace_instr(context.rsp, op_name); \\\n break\n// clang-format off\n#define PZ_RUN_ARITHMETIC1(opcode_base, width, signedness, operator, op_name) \\\n case opcode_base##_##width: \\\n context.expr_stack[context.esp].signedness##width = \\\n operator context.expr_stack[context.esp].signedness##width; \\\n pz_trace_instr(context.rsp, op_name); \\\n break\n// clang-format on\n\n PZ_RUN_ARITHMETIC(PZT_ADD, 8, s, +, \"add:8\");\n PZ_RUN_ARITHMETIC(PZT_ADD, 16, s, +, \"add:16\");\n PZ_RUN_ARITHMETIC(PZT_ADD, 32, s, +, \"add:32\");\n PZ_RUN_ARITHMETIC(PZT_ADD, 64, s, +, \"add:64\");\n PZ_RUN_ARITHMETIC(PZT_SUB, 8, s, -, \"sub:8\");\n PZ_RUN_ARITHMETIC(PZT_SUB, 16, s, -, \"sub:16\");\n PZ_RUN_ARITHMETIC(PZT_SUB, 32, s, -, \"sub:32\");\n PZ_RUN_ARITHMETIC(PZT_SUB, 64, s, -, \"sub:64\");\n PZ_RUN_ARITHMETIC(PZT_MUL, 8, s, *, \"mul:8\");\n PZ_RUN_ARITHMETIC(PZT_MUL, 16, s, *, \"mul:16\");\n PZ_RUN_ARITHMETIC(PZT_MUL, 32, s, *, \"mul:32\");\n PZ_RUN_ARITHMETIC(PZT_MUL, 64, s, *, \"mul:64\");\n PZ_RUN_ARITHMETIC(PZT_DIV, 8, s, /, \"div:8\");\n PZ_RUN_ARITHMETIC(PZT_DIV, 16, s, /, \"div:16\");\n PZ_RUN_ARITHMETIC(PZT_DIV, 32, s, /, \"div:32\");\n PZ_RUN_ARITHMETIC(PZT_DIV, 64, s, /, \"div:64\");\n PZ_RUN_ARITHMETIC(PZT_MOD, 8, s, %, \"rem:8\");\n PZ_RUN_ARITHMETIC(PZT_MOD, 16, s, %, \"rem:16\");\n PZ_RUN_ARITHMETIC(PZT_MOD, 32, s, %, \"rem:32\");\n PZ_RUN_ARITHMETIC(PZT_MOD, 64, s, %, \"rem:64\");\n PZ_RUN_ARITHMETIC(PZT_AND, 8, u, &, \"and:8\");\n PZ_RUN_ARITHMETIC(PZT_AND, 16, u, &, \"and:16\");\n PZ_RUN_ARITHMETIC(PZT_AND, 32, u, &, \"and:32\");\n PZ_RUN_ARITHMETIC(PZT_AND, 64, u, &, \"and:64\");\n PZ_RUN_ARITHMETIC(PZT_OR, 8, u, |, \"or:8\");\n PZ_RUN_ARITHMETIC(PZT_OR, 16, u, |, \"or:16\");\n PZ_RUN_ARITHMETIC(PZT_OR, 32, u, |, \"or:32\");\n PZ_RUN_ARITHMETIC(PZT_OR, 64, u, |, \"or:64\");\n PZ_RUN_ARITHMETIC(PZT_XOR, 8, u, ^, \"xor:8\");\n PZ_RUN_ARITHMETIC(PZT_XOR, 16, u, ^, \"xor:16\");\n PZ_RUN_ARITHMETIC(PZT_XOR, 32, u, ^, \"xor:32\");\n PZ_RUN_ARITHMETIC(PZT_XOR, 64, u, ^, \"xor:64\");\n PZ_RUN_ARITHMETIC(PZT_LT_U, 8, u, <, \"ltu:8\");\n PZ_RUN_ARITHMETIC(PZT_LT_U, 16, u, <, \"ltu:16\");\n PZ_RUN_ARITHMETIC(PZT_LT_U, 32, u, <, \"ltu:32\");\n PZ_RUN_ARITHMETIC(PZT_LT_U, 64, u, <, \"ltu:64\");\n PZ_RUN_ARITHMETIC(PZT_LT_S, 8, s, <, \"lts:8\");\n PZ_RUN_ARITHMETIC(PZT_LT_S, 16, s, <, \"lts:16\");\n PZ_RUN_ARITHMETIC(PZT_LT_S, 32, s, <, \"lts:32\");\n PZ_RUN_ARITHMETIC(PZT_LT_S, 64, s, <, \"lts:64\");\n PZ_RUN_ARITHMETIC(PZT_GT_U, 8, u, >, \"gtu:8\");\n PZ_RUN_ARITHMETIC(PZT_GT_U, 16, u, >, \"gtu:16\");\n PZ_RUN_ARITHMETIC(PZT_GT_U, 32, u, >, \"gtu:32\");\n PZ_RUN_ARITHMETIC(PZT_GT_U, 64, u, >, \"gtu:64\");\n PZ_RUN_ARITHMETIC(PZT_GT_S, 8, s, >, \"gts:8\");\n PZ_RUN_ARITHMETIC(PZT_GT_S, 16, s, >, \"gts:16\");\n PZ_RUN_ARITHMETIC(PZT_GT_S, 32, s, >, \"gts:32\");\n PZ_RUN_ARITHMETIC(PZT_GT_S, 64, s, >, \"gts:64\");\n PZ_RUN_ARITHMETIC(PZT_EQ, 8, s, ==, \"eq:8\");\n PZ_RUN_ARITHMETIC(PZT_EQ, 16, s, ==, \"eq:16\");\n PZ_RUN_ARITHMETIC(PZT_EQ, 32, s, ==, \"eq:32\");\n PZ_RUN_ARITHMETIC(PZT_EQ, 64, s, ==, \"eq:64\");\n PZ_RUN_ARITHMETIC1(PZT_NOT, 8, u, !, \"not:8\");\n PZ_RUN_ARITHMETIC1(PZT_NOT, 16, u, !, \"not:16\");\n PZ_RUN_ARITHMETIC1(PZT_NOT, 32, u, !, \"not:16\");\n PZ_RUN_ARITHMETIC1(PZT_NOT, 64, u, !, \"not:16\");\n\n#undef PZ_RUN_ARITHMETIC\n#undef PZ_RUN_ARITHMETIC1\n\n#define PZ_RUN_SHIFT(opcode_base, width, operator, op_name) \\\n case opcode_base##_##width: \\\n context.expr_stack[context.esp - 1].u##width = \\\n (context.expr_stack[context.esp - 1] \\\n .u##width \\\n operator context.expr_stack[context.esp] \\\n .u8); \\\n context.esp--; \\\n pz_trace_instr(context.rsp, op_name); \\\n break\n\n PZ_RUN_SHIFT(PZT_LSHIFT, 8, <<, \"lshift:8\");\n PZ_RUN_SHIFT(PZT_LSHIFT, 16, <<, \"lshift:16\");\n PZ_RUN_SHIFT(PZT_LSHIFT, 32, <<, \"lshift:32\");\n PZ_RUN_SHIFT(PZT_LSHIFT, 64, <<, \"lshift:64\");\n PZ_RUN_SHIFT(PZT_RSHIFT, 8, >>, \"rshift:8\");\n PZ_RUN_SHIFT(PZT_RSHIFT, 16, >>, \"rshift:16\");\n PZ_RUN_SHIFT(PZT_RSHIFT, 32, >>, \"rshift:32\");\n PZ_RUN_SHIFT(PZT_RSHIFT, 64, >>, \"rshift:64\");\n\n#undef PZ_RUN_SHIFT\n\n case PZT_DUP:\n context.esp++;\n context.expr_stack[context.esp] =\n context.expr_stack[context.esp - 1];\n pz_trace_instr(context.rsp, \"dup\");\n break;\n case PZT_DROP:\n context.esp--;\n pz_trace_instr(context.rsp, \"drop\");\n break;\n case PZT_SWAP: {\n StackValue temp;\n temp = context.expr_stack[context.esp];\n context.expr_stack[context.esp] =\n context.expr_stack[context.esp - 1];\n context.expr_stack[context.esp - 1] = temp;\n pz_trace_instr(context.rsp, \"swap\");\n break;\n }\n case PZT_ROLL: {\n uint8_t depth = *context.ip;\n StackValue temp;\n context.ip++;\n switch (depth) {\n case 0:\n fprintf(stderr, \"Illegal rot depth 0\");\n abort();\n case 1:\n break;\n default:\n /*\n * subtract 1 as the 1st element on the stack is\n * context.esp - 0, not context.esp - 1\n */\n depth--;\n temp = context.expr_stack[context.esp - depth];\n for (int i = depth; i > 0; i--) {\n context.expr_stack[context.esp - i] =\n context.expr_stack[context.esp - (i - 1)];\n }\n context.expr_stack[context.esp] = temp;\n }\n pz_trace_instr2(context.rsp, \"roll\", depth + 1);\n break;\n }\n case PZT_PICK: {\n /*\n * As with PZT_ROLL we would subract 1 here, but we also\n * have to add 1 because we increment the stack pointer\n * before accessing the stack.\n */\n uint8_t depth = *context.ip;\n context.ip++;\n context.esp++;\n context.expr_stack[context.esp] =\n context.expr_stack[context.esp - depth];\n pz_trace_instr2(context.rsp, \"pick\", depth);\n break;\n }\n case PZT_CALL: {\n Closure * closure;\n\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n context.return_stack[++context.rsp] =\n static_cast(context.env);\n context.return_stack[++context.rsp] =\n context.ip + WORDSIZE_BYTES;\n closure = *(Closure **)context.ip;\n context.ip = static_cast(closure->code());\n context.env = closure->data();\n\n pz_trace_instr(context.rsp, \"call\");\n break;\n }\n case PZT_CALL_IND: {\n Closure * closure;\n\n context.return_stack[++context.rsp] =\n static_cast(context.env);\n context.return_stack[++context.rsp] = context.ip;\n\n closure = (Closure *)context.expr_stack[context.esp--].ptr;\n context.ip = static_cast(closure->code());\n context.env = closure->data();\n\n pz_trace_instr(context.rsp, \"call_ind\");\n break;\n }\n case PZT_CALL_PROC:\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n context.return_stack[++context.rsp] =\n static_cast(context.env);\n context.return_stack[++context.rsp] =\n context.ip + WORDSIZE_BYTES;\n context.ip = *(uint8_t **)context.ip;\n pz_trace_instr(context.rsp, \"call_proc\");\n break;\n case PZT_TCALL: {\n Closure * closure;\n\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n closure = *(Closure **)context.ip;\n context.ip = static_cast(closure->code());\n context.env = closure->data();\n\n pz_trace_instr(context.rsp, \"tcall\");\n break;\n }\n case PZT_TCALL_IND: {\n Closure * closure;\n\n closure = (Closure *)context.expr_stack[context.esp--].ptr;\n context.ip = static_cast(closure->code());\n context.env = closure->data();\n\n pz_trace_instr(context.rsp, \"call_ind\");\n break;\n }\n case PZT_TCALL_PROC:\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n context.ip = *(uint8_t **)context.ip;\n pz_trace_instr(context.rsp, \"tcall_proc\");\n break;\n case PZT_CJMP_8:\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n if (context.expr_stack[context.esp--].u8) {\n context.ip = *(uint8_t **)context.ip;\n pz_trace_instr(context.rsp, \"cjmp:8 taken\");\n } else {\n context.ip += WORDSIZE_BYTES;\n pz_trace_instr(context.rsp, \"cjmp:8 not taken\");\n }\n break;\n case PZT_CJMP_16:\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n if (context.expr_stack[context.esp--].u16) {\n context.ip = *(uint8_t **)context.ip;\n pz_trace_instr(context.rsp, \"cjmp:16 taken\");\n } else {\n context.ip += WORDSIZE_BYTES;\n pz_trace_instr(context.rsp, \"cjmp:16 not taken\");\n }\n break;\n case PZT_CJMP_32:\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n if (context.expr_stack[context.esp--].u32) {\n context.ip = *(uint8_t **)context.ip;\n pz_trace_instr(context.rsp, \"cjmp:32 taken\");\n } else {\n context.ip += WORDSIZE_BYTES;\n pz_trace_instr(context.rsp, \"cjmp:32 not taken\");\n }\n break;\n case PZT_CJMP_64:\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n if (context.expr_stack[context.esp--].u64) {\n context.ip = *(uint8_t **)context.ip;\n pz_trace_instr(context.rsp, \"cjmp:64 taken\");\n } else {\n context.ip += WORDSIZE_BYTES;\n pz_trace_instr(context.rsp, \"cjmp:64 not taken\");\n }\n break;\n case PZT_JMP:\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n context.ip = *(uint8_t **)context.ip;\n pz_trace_instr(context.rsp, \"jmp\");\n break;\n case PZT_RET:\n context.ip = context.return_stack[context.rsp--];\n context.env = context.return_stack[context.rsp--];\n pz_trace_instr(context.rsp, \"ret\");\n break;\n case PZT_ALLOC: {\n size_t size;\n void * addr;\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n size = *(size_t *)context.ip;\n context.ip += WORDSIZE_BYTES;\n // pz_gc_alloc uses size in machine words, round the value\n // up and convert it to words rather than bytes.\n addr =\n context.alloc((size + WORDSIZE_BYTES - 1) / WORDSIZE_BYTES);\n context.expr_stack[++context.esp].ptr = addr;\n pz_trace_instr(context.rsp, \"alloc\");\n break;\n }\n case PZT_MAKE_CLOSURE: {\n void *code, *data;\n\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n code = *(void **)context.ip;\n context.ip = (context.ip + WORDSIZE_BYTES);\n data = context.expr_stack[context.esp].ptr;\n Closure * closure =\n new (context) Closure(static_cast(code), data);\n context.expr_stack[context.esp].ptr = closure;\n pz_trace_instr(context.rsp, \"make_closure\");\n break;\n }\n case PZT_LOAD_8: {\n uint16_t offset;\n void * addr;\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n offset = *(uint16_t *)context.ip;\n context.ip += 2;\n /* (ptr - * ptr) */\n addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset;\n context.expr_stack[context.esp + 1].ptr =\n context.expr_stack[context.esp].ptr;\n context.expr_stack[context.esp].u8 = *(uint8_t *)addr;\n context.esp++;\n pz_trace_instr(context.rsp, \"load_8\");\n break;\n }\n case PZT_LOAD_16: {\n uint16_t offset;\n void * addr;\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n offset = *(uint16_t *)context.ip;\n context.ip += 2;\n /* (ptr - * ptr) */\n addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset;\n context.expr_stack[context.esp + 1].ptr =\n context.expr_stack[context.esp].ptr;\n context.expr_stack[context.esp].u16 = *(uint16_t *)addr;\n context.esp++;\n pz_trace_instr(context.rsp, \"load_16\");\n break;\n }\n case PZT_LOAD_32: {\n uint16_t offset;\n void * addr;\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n offset = *(uint16_t *)context.ip;\n context.ip += 2;\n /* (ptr - * ptr) */\n addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset;\n context.expr_stack[context.esp + 1].ptr =\n context.expr_stack[context.esp].ptr;\n context.expr_stack[context.esp].u32 = *(uint32_t *)addr;\n context.esp++;\n pz_trace_instr(context.rsp, \"load_32\");\n break;\n }\n case PZT_LOAD_64: {\n uint16_t offset;\n void * addr;\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n offset = *(uint16_t *)context.ip;\n context.ip += 2;\n /* (ptr - * ptr) */\n addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset;\n context.expr_stack[context.esp + 1].ptr =\n context.expr_stack[context.esp].ptr;\n context.expr_stack[context.esp].u64 = *(uint64_t *)addr;\n context.esp++;\n pz_trace_instr(context.rsp, \"load_64\");\n break;\n }\n case PZT_LOAD_PTR: {\n uint16_t offset;\n void * addr;\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n offset = *(uint16_t *)context.ip;\n context.ip += 2;\n /* (ptr - ptr ptr) */\n addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset;\n context.expr_stack[context.esp + 1].ptr =\n context.expr_stack[context.esp].ptr;\n context.expr_stack[context.esp].ptr = *(void **)addr;\n context.esp++;\n pz_trace_instr(context.rsp, \"load_ptr\");\n break;\n }\n case PZT_STORE_8: {\n uint16_t offset;\n void * addr;\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n offset = *(uint16_t *)context.ip;\n context.ip += 2;\n /* (* ptr - ptr) */\n addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset;\n *(uint8_t *)addr = context.expr_stack[context.esp - 1].u8;\n context.expr_stack[context.esp - 1].ptr =\n context.expr_stack[context.esp].ptr;\n context.esp--;\n pz_trace_instr(context.rsp, \"store_8\");\n break;\n }\n case PZT_STORE_16: {\n uint16_t offset;\n void * addr;\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n offset = *(uint16_t *)context.ip;\n context.ip += 2;\n /* (* ptr - ptr) */\n addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset;\n *(uint16_t *)addr = context.expr_stack[context.esp - 1].u16;\n context.expr_stack[context.esp - 1].ptr =\n context.expr_stack[context.esp].ptr;\n context.esp--;\n pz_trace_instr(context.rsp, \"store_16\");\n break;\n }\n case PZT_STORE_32: {\n uint16_t offset;\n void * addr;\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n offset = *(uint16_t *)context.ip;\n context.ip += 2;\n /* (* ptr - ptr) */\n addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset;\n *(uint32_t *)addr = context.expr_stack[context.esp - 1].u32;\n context.expr_stack[context.esp - 1].ptr =\n context.expr_stack[context.esp].ptr;\n context.esp--;\n pz_trace_instr(context.rsp, \"store_32\");\n break;\n }\n case PZT_STORE_64: {\n uint16_t offset;\n void * addr;\n context.ip = (uint8_t *)AlignUp((size_t)context.ip, 2);\n offset = *(uint16_t *)context.ip;\n context.ip += 2;\n /* (* ptr - ptr) */\n addr = (uint8_t *)context.expr_stack[context.esp].ptr + offset;\n *(uint64_t *)addr = context.expr_stack[context.esp - 1].u64;\n context.expr_stack[context.esp - 1].ptr =\n context.expr_stack[context.esp].ptr;\n context.esp--;\n pz_trace_instr(context.rsp, \"store_64\");\n break;\n }\n case PZT_GET_ENV: {\n context.expr_stack[++context.esp].ptr = context.env;\n pz_trace_instr(context.rsp, \"get_env\");\n break;\n }\n\n case PZT_END:\n retcode = context.expr_stack[context.esp].s32;\n if (context.esp != 1) {\n fprintf(stderr,\n \"Stack misaligned, esp: %d should be 1\\n\",\n context.esp);\n abort();\n }\n pz_trace_instr(context.rsp, \"end\");\n pz_trace_state(heap,\n context.ip,\n context.env,\n context.rsp,\n context.esp,\n (uint64_t *)context.expr_stack.ptr());\n return retcode;\n case PZT_CCALL: {\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n pz_foreign_c_func callee = \n *reinterpret_cast(context.ip);\n context.esp = callee(context.expr_stack.ptr(), context.esp);\n context.ip += WORDSIZE_BYTES;\n pz_trace_instr(context.rsp, \"ccall\");\n break;\n }\n case PZT_CCALL_ALLOC: {\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n pz_foreign_c_alloc_func callee = \n *reinterpret_cast(context.ip);\n context.esp = callee(context.expr_stack.ptr(), context.esp, \n context);\n context.ip += WORDSIZE_BYTES;\n pz_trace_instr(context.rsp, \"ccall\");\n break;\n }\n case PZT_CCALL_SPECIAL: {\n context.ip =\n (uint8_t *)AlignUp((size_t)context.ip, WORDSIZE_BYTES);\n pz_foreign_c_special_func callee =\n *reinterpret_cast(context.ip);\n context.esp = callee(context.expr_stack.ptr(), context.esp, pz);\n context.ip += WORDSIZE_BYTES;\n pz_trace_instr(context.rsp, \"ccall\");\n break;\n }\n#ifdef PZ_DEV\n case PZT_INVALID_TOKEN:\n fprintf(stderr, \"Attempt to execute poisoned memory\\n\");\n abort();\n#endif\n default:\n fprintf(stderr, \"Unknown opcode\\n\");\n abort();\n }\n pz_trace_state(heap,\n context.ip,\n context.env,\n context.rsp,\n context.esp,\n (uint64_t *)context.expr_stack.ptr());\n }\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_generic_run.h", "content": "/*\n * Plasma bytecode generic interpreter definitions\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_GENERIC_RUN_H\n#define PZ_GENERIC_RUN_H\n\n#include \"pz.h\"\n#include \"pz_closure.h\"\n#include \"pz_gc.h\"\n#include \"pz_generic_closure.h\"\n#include \"pz_memory.h\"\n\nnamespace pz {\n\n/*\n * Tokens for the token-oriented execution.\n */\nenum InstructionToken {\n PZT_NOP,\n PZT_LOAD_IMMEDIATE_8,\n PZT_LOAD_IMMEDIATE_16,\n PZT_LOAD_IMMEDIATE_32,\n PZT_LOAD_IMMEDIATE_64,\n PZT_ZE_8_16,\n PZT_ZE_8_32,\n PZT_ZE_8_64,\n PZT_ZE_16_32,\n PZT_ZE_16_64,\n PZT_ZE_32_64,\n PZT_SE_8_16,\n PZT_SE_8_32,\n PZT_SE_8_64,\n PZT_SE_16_32,\n PZT_SE_16_64,\n PZT_SE_32_64,\n PZT_TRUNC_64_32,\n PZT_TRUNC_64_16,\n PZT_TRUNC_64_8,\n PZT_TRUNC_32_16,\n PZT_TRUNC_32_8,\n PZT_TRUNC_16_8,\n PZT_ADD_8,\n PZT_ADD_16,\n PZT_ADD_32,\n PZT_ADD_64,\n PZT_SUB_8,\n PZT_SUB_16,\n PZT_SUB_32,\n PZT_SUB_64,\n PZT_MUL_8,\n PZT_MUL_16,\n PZT_MUL_32,\n PZT_MUL_64,\n PZT_DIV_8,\n PZT_DIV_16,\n PZT_DIV_32,\n PZT_DIV_64,\n PZT_MOD_8,\n PZT_MOD_16,\n PZT_MOD_32,\n PZT_MOD_64,\n PZT_LSHIFT_8,\n PZT_LSHIFT_16,\n PZT_LSHIFT_32,\n PZT_LSHIFT_64,\n PZT_RSHIFT_8,\n PZT_RSHIFT_16,\n PZT_RSHIFT_32,\n PZT_RSHIFT_64,\n PZT_AND_8,\n PZT_AND_16,\n PZT_AND_32,\n PZT_AND_64,\n PZT_OR_8,\n PZT_OR_16,\n PZT_OR_32,\n PZT_OR_64,\n PZT_XOR_8,\n PZT_XOR_16,\n PZT_XOR_32,\n PZT_XOR_64,\n PZT_LT_U_8,\n PZT_LT_U_16,\n PZT_LT_U_32,\n PZT_LT_U_64,\n PZT_LT_S_8,\n PZT_LT_S_16,\n PZT_LT_S_32,\n PZT_LT_S_64,\n PZT_GT_U_8,\n PZT_GT_U_16,\n PZT_GT_U_32,\n PZT_GT_U_64,\n PZT_GT_S_8,\n PZT_GT_S_16,\n PZT_GT_S_32,\n PZT_GT_S_64,\n PZT_EQ_8,\n PZT_EQ_16,\n PZT_EQ_32,\n PZT_EQ_64,\n PZT_NOT_8,\n PZT_NOT_16,\n PZT_NOT_32,\n PZT_NOT_64,\n PZT_DUP,\n PZT_DROP,\n PZT_SWAP,\n PZT_ROLL,\n PZT_PICK,\n PZT_CALL,\n PZT_CALL_IND,\n PZT_CALL_PROC,\n PZT_TCALL,\n PZT_TCALL_IND,\n PZT_TCALL_PROC,\n PZT_CJMP_8,\n PZT_CJMP_16,\n PZT_CJMP_32,\n PZT_CJMP_64,\n PZT_JMP,\n PZT_RET,\n PZT_ALLOC,\n PZT_MAKE_CLOSURE,\n PZT_LOAD_8,\n PZT_LOAD_16,\n PZT_LOAD_32,\n PZT_LOAD_64,\n PZT_LOAD_PTR,\n PZT_STORE_8,\n PZT_STORE_16,\n PZT_STORE_32,\n PZT_STORE_64,\n PZT_GET_ENV,\n PZT_END, // Not part of PZ format.\n PZT_CCALL, // Not part of PZ format.\n PZT_CCALL_ALLOC, // Not part of PZ format.\n PZT_CCALL_SPECIAL, // Not part of PZ format.\n PZT_LAST_TOKEN = PZT_CCALL_ALLOC,\n#ifdef PZ_DEV\n PZT_INVALID_TOKEN = 0xF0,\n#endif\n};\n\nunion StackValue {\n uint8_t u8;\n int8_t s8;\n uint16_t u16;\n int16_t s16;\n uint32_t u32;\n int32_t s32;\n uint64_t u64;\n int64_t s64;\n uintptr_t uptr;\n intptr_t sptr;\n void * ptr;\n};\n\n#define RETURN_STACK_SIZE 2048*4\n#define EXPR_STACK_SIZE 4096*4\n\nstruct Context final : public AbstractGCTracer {\n uint8_t * ip;\n void * env;\n Memory return_stack;\n unsigned rsp;\n Memory expr_stack;\n unsigned esp;\n\n Context(GCCapability & gc);\n ~Context();\n\n bool allocate();\n bool release(bool fast);\n\n void do_trace(HeapMarkState * state) const override;\n};\n\nint\ngeneric_main_loop(Context &context,\n Heap *heap,\n Closure *closure,\n PZ &pz);\n\n} // namespace pz\n\n#endif // ! PZ_GENERIC_RUN_H\n" }, { "path": "runtime/pz_instructions.cpp", "content": "/*\n * Plasma bytecode instructions\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \"pz_instructions.h\"\n\nnamespace pz {\n\n/*\n * Instruction encoding\n *\n *************************/\n\nInstructionInfo instruction_info[] = {\n /* PZI_LOAD_IMMEDIATE_NUM\n * XXX: The immediate value is always encoded as a 32 bit number but\n * this restriction should be lifted.\n */\n {1, IMT_32},\n /* PZI_ZE */\n {2, IMT_NONE},\n /* PZI_SE */\n {2, IMT_NONE},\n /* PZI_TRUNC */\n {2, IMT_NONE},\n /* PZI_ADD */\n {1, IMT_NONE},\n /* PZI_SUB */\n {1, IMT_NONE},\n /* PZI_MUL */\n {1, IMT_NONE},\n /* PZI_DIV */\n {1, IMT_NONE},\n /* PZI_MOD */\n {1, IMT_NONE},\n /* PZI_LSHIFT */\n {1, IMT_NONE},\n /* PZI_RSHIFT */\n {1, IMT_NONE},\n /* PZI_AND */\n {1, IMT_NONE},\n /* PZI_OR */\n {1, IMT_NONE},\n /* PZI_XOR */\n {1, IMT_NONE},\n /* PZI_LT_U, PZT_LT_S, PZT_GT_U and PZT_GT_S */\n {1, IMT_NONE},\n {1, IMT_NONE},\n {1, IMT_NONE},\n {1, IMT_NONE},\n /* PZI_EQ */\n {1, IMT_NONE},\n /* PZI_NOT */\n {1, IMT_NONE},\n /* PZI_DROP */\n {0, IMT_NONE},\n /* PZI_ROLL */\n {0, IMT_8},\n /* PZI_PICK */\n {0, IMT_8},\n /* PZI_CALL */\n {0, IMT_CLOSURE_REF},\n /* PZI_CALL_IMPORT */\n {0, IMT_IMPORT_CLOSURE_REF},\n /* PZI_CALL_IND */\n {0, IMT_NONE},\n /* PZI_CALL_PROC */\n {0, IMT_PROC_REF},\n /* PZI_TCALL */\n {0, IMT_CLOSURE_REF},\n /* PZI_TCALL_IMPORT */\n {0, IMT_IMPORT_CLOSURE_REF},\n /* PZI_TCALL_IND */\n {0, IMT_NONE},\n /* PZI_TCALL_PROC */\n {0, IMT_PROC_REF},\n /* PZI_RET */\n {0, IMT_NONE},\n /* PZI_CJMP */\n {1, IMT_LABEL_REF},\n /* PZI_JMP */\n {0, IMT_LABEL_REF},\n\n /* PZI_ALLOC */\n {0, IMT_STRUCT_REF},\n /* PZI_MAKE_CLOSURE */\n {0, IMT_PROC_REF},\n /* PZI_LOAD */\n {1, IMT_STRUCT_REF_FIELD},\n /* PZI_STORE */\n {1, IMT_STRUCT_REF_FIELD},\n /* PZI_GET_ENV */\n {0, IMT_NONE},\n\n /* Non-encoded instructions */\n /* PZI_END */\n {0, IMT_NONE},\n /* PZI_CCALL */\n {0, IMT_PROC_REF},\n /* PZI_CCALL_ALLOC */\n {0, IMT_PROC_REF},\n /* PZI_CCALL_SPECIAL */\n {0, IMT_PROC_REF}};\n\n} // namespace pz\n" }, { "path": "runtime/pz_instructions.h", "content": "/*\n * Plasma bytecode instructions\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_INSTRUCTIONS_H\n#define PZ_INSTRUCTIONS_H\n\n/*\n * Instructions are made from an opcode (byte), then depending on the opcode\n * zero or more bytes describing the width of the operands, and zero or one\n * intermediate values.\n *\n * For example, PZI_CALL is followed by zero operand width bytes and one\n * intermediate value, the reference to the callee. Likewise, PZI_ADD is\n * followed by one operand width byte describing the width of the data used\n * in the addition (both inputs and the output).\n */\n\ntypedef enum {\n /*\n * These instructions may appear in bytecode.\n * XXX: Need a way to load immedate data with a fast opcode width but\n * whose static data may be some other size.\n */\n PZI_LOAD_IMMEDIATE_NUM = 0,\n PZI_ZE,\n PZI_SE,\n PZI_TRUNC,\n PZI_ADD,\n PZI_SUB,\n PZI_MUL,\n /*\n * TODO: Check how signedness affects division/modulo.\n */\n PZI_DIV,\n PZI_MOD,\n PZI_LSHIFT,\n /*\n * TODO: Right shift is unsigned, need to add a signed version.\n */\n PZI_RSHIFT,\n PZI_AND,\n PZI_OR,\n PZI_XOR,\n PZI_LT_U,\n PZI_LT_S,\n PZI_GT_U,\n PZI_GT_S,\n PZI_EQ,\n PZI_NOT,\n PZI_DROP,\n /*\n * rotate N-1 items to the left, the leftmost item becomes the rightmost\n * item.\n */\n PZI_ROLL,\n PZI_PICK,\n PZI_CALL,\n PZI_CALL_IMPORT,\n PZI_CALL_IND,\n PZI_CALL_PROC,\n PZI_TCALL,\n PZI_TCALL_IMPORT,\n PZI_TCALL_IND,\n PZI_TCALL_PROC,\n PZI_RET,\n PZI_CJMP,\n PZI_JMP,\n\n PZI_ALLOC,\n PZI_MAKE_CLOSURE,\n PZI_LOAD,\n PZI_STORE,\n PZI_GET_ENV,\n\n /*\n * These instructions do not appear in bytecode, they are implied by\n * other instructions during bytecode loading and inserted into the\n * instruction stream then.\n */\n PZI_END,\n PZI_CCALL,\n PZI_CCALL_ALLOC,\n PZI_CCALL_SPECIAL,\n} PZ_Opcode;\n\n#define PZ_NUM_OPCODES (PZI_CCALL_SPECIAL + 1)\n\n#ifdef __cplusplus\n\nnamespace pz {\n\nunion ImmediateValue {\n uint8_t uint8;\n uint16_t uint16;\n uint32_t uint32;\n uint64_t uint64;\n uintptr_t word;\n};\n\nenum ImmediateType {\n IMT_NONE,\n IMT_8,\n IMT_16,\n IMT_32,\n IMT_64,\n IMT_CLOSURE_REF,\n IMT_PROC_REF,\n IMT_IMPORT_CLOSURE_REF,\n IMT_STRUCT_REF,\n IMT_STRUCT_REF_FIELD,\n IMT_LABEL_REF\n};\n\nstruct InstructionInfo {\n unsigned ii_num_width_bytes;\n ImmediateType ii_immediate_type;\n};\n\n/*\n * Instruction info is indexed by opcode\n */\nextern InstructionInfo instruction_info[];\n\n} // namespace pz\n\n#endif\n\n#endif /* ! PZ_INSTRUCTIONS_H */\n" }, { "path": "runtime/pz_interp.h", "content": "/*\n * Plasma bytecode exection\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_INTERP_H\n#define PZ_INTERP_H\n\n#include \"pz.h\"\n#include \"pz_format.h\"\n#include \"pz_gc.h\"\n#include \"pz_instructions.h\"\n#include \"pz_option.h\"\n\n/*\n * Run the program.\n *\n ******************/\n\nnamespace pz {\n\nint run(PZ & pz, const Options & options, GCCapability & gc);\n\n/*\n * Foreign functions.\n *\n * The exact meaning of the parameters depends upon implementation details\n * within pz_run_*.c.\n *\n ******************************/\n\ntypedef unsigned (*pz_foreign_c_func)(void * stack, unsigned sp);\n\ntypedef unsigned (*pz_foreign_c_alloc_func)(void * stack, unsigned sp,\n AbstractGCTracer & gc_trace);\n\ntypedef unsigned (*pz_foreign_c_special_func)(void * stack, unsigned sp,\n PZ & pz);\n\nunsigned pz_builtin_print_func(void * stack, unsigned sp);\n\nunsigned pz_builtin_readline_func(void * stack, unsigned sp,\n AbstractGCTracer & gc_trace);\n\nunsigned pz_builtin_int_to_string_func(void * stack, unsigned sp,\n AbstractGCTracer & gc_trace);\n\nunsigned pz_builtin_setenv_func(void * stack, unsigned sp);\n\nunsigned pz_builtin_gettimeofday_func(void * void_stack, unsigned sp);\n\nunsigned pz_builtin_string_concat_func(void * stack, unsigned sp,\n AbstractGCTracer & gc_trace);\n\nunsigned pz_builtin_die_func(void * stack, unsigned sp);\n\nunsigned pz_builtin_set_parameter_func(void * stack, unsigned sp, PZ & pz);\n\nunsigned pz_builtin_get_parameter_func(void * stack, unsigned sp, PZ & pz);\n\nunsigned pz_builtin_codepoint_category(void * stack, unsigned sp);\nunsigned pz_builtin_codepoint_to_string(void * stack, unsigned sp,\n AbstractGCTracer & gc);\nunsigned pz_builtin_strpos_forward(void * stack, unsigned sp,\n AbstractGCTracer & gc);\nunsigned pz_builtin_strpos_backward(void * stack, unsigned sp,\n AbstractGCTracer & gc);\nunsigned pz_builtin_strpos_next_char(void * stack, unsigned sp,\n AbstractGCTracer & gc);\nunsigned pz_builtin_strpos_prev_char(void * stack, unsigned sp,\n AbstractGCTracer & gc);\nunsigned pz_builtin_string_begin(void * stack, unsigned sp,\n AbstractGCTracer & gc);\nunsigned pz_builtin_string_end(void * stack, unsigned sp,\n AbstractGCTracer & gc);\nunsigned pz_builtin_string_substring(void * stack, unsigned sp,\n AbstractGCTracer & gc);\nunsigned pz_builtin_string_equals(void * stack, unsigned sp);\n\n/*\n * The size of \"fast\" integers in bytes.\n */\nextern const unsigned fast_word_size;\n\n/*\n * The number of tag bits made available by the runtime.\n * Guarenteed to match or exceed ptag_bits from src/core_to_pz.data.m\n */\nextern const unsigned num_tag_bits;\nextern const uintptr_t tag_bits;\n\n/*\n * Build the raw code of the program.\n *\n ************************************/\n\n/*\n * Write the instruction into the procedure at the given offset.\n * Returns the new offset within the procedure for the next instruction.\n * If proc is NULL then nothing is written but a new offset is computed,\n * this can be used in a first pass to calculate the required size of the\n * procedure.\n *\n * If the immediate value needs extending to the operation width it will be\n * zero-extended.\n */\nunsigned\nwrite_instr(uint8_t *proc,\n unsigned offset,\n PZ_Opcode opcode);\n\nunsigned\nwrite_instr(uint8_t *proc,\n unsigned offset,\n PZ_Opcode opcode,\n ImmediateType imm_type,\n ImmediateValue imm);\n\nunsigned\nwrite_instr(uint8_t *proc,\n unsigned offset,\n PZ_Opcode opcode,\n PZ_Width width1);\n\nunsigned\nwrite_instr(uint8_t *proc,\n unsigned offset,\n PZ_Opcode opcode,\n PZ_Width width1,\n ImmediateType imm_type,\n ImmediateValue imm);\n\nunsigned\nwrite_instr(uint8_t *proc,\n unsigned offset,\n PZ_Opcode opcode,\n PZ_Width width1,\n PZ_Width width2);\n\n}\n\n#endif /* ! PZ_INTERP_H */\n" }, { "path": "runtime/pz_io.cpp", "content": "/*\n * IO Utils.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \n#include \n\n#include \"pz_common.h\"\n\n#include \"pz_io.h\"\n\nnamespace pz {\n\nBinaryInput::~BinaryInput()\n{\n if (m_file) {\n assert(!m_filename.empty());\n if (ferror(m_file)) {\n perror(m_filename.c_str());\n } else if (feof(m_file)) {\n fprintf(\n stderr, \"%s: Unexpected end of file.\\n\", m_filename.c_str());\n }\n close();\n }\n assert(!m_file);\n assert(m_filename.empty());\n}\n\nbool BinaryInput::open(const std::string & filename)\n{\n assert(!m_file);\n assert(m_filename.empty());\n m_file = fopen(filename.c_str(), \"rb\");\n if (m_file) {\n m_filename = std::string(filename);\n return true;\n } else {\n return false;\n }\n}\n\nvoid BinaryInput::close()\n{\n assert(m_file);\n fclose(m_file);\n m_file = nullptr;\n assert(!m_filename.empty());\n m_filename.clear();\n}\n\nconst std::string & BinaryInput::filename() const\n{\n return m_filename;\n}\n\nconst char * BinaryInput::filename_c() const\n{\n return filename().c_str();\n}\n\nbool BinaryInput::seek_set(long pos)\n{\n assert(pos >= 0);\n return fseek(m_file, pos, SEEK_SET) == 0;\n}\n\nbool BinaryInput::seek_cur(long pos)\n{\n return fseek(m_file, pos, SEEK_CUR) == 0;\n}\n\nOptional BinaryInput::tell() const\n{\n long pos = ftell(m_file);\n if (pos < 0) {\n return Optional::Nothing();\n } else {\n return Optional(pos);\n }\n}\n\nbool BinaryInput::is_at_eof()\n{\n return !!feof(m_file);\n}\n\nbool BinaryInput::read_uint8(uint8_t * value)\n{\n return (1 == fread(value, sizeof(uint8_t), 1, m_file));\n}\n\nbool BinaryInput::read_uint16(uint16_t * value)\n{\n uint8_t bytes[2];\n\n if (!fread(bytes, sizeof(uint8_t), 2, m_file)) {\n return false;\n }\n\n *value = ((uint16_t)bytes[1] << 8) | (uint16_t)bytes[0];\n\n return true;\n}\n\nbool BinaryInput::read_uint32(uint32_t * value)\n{\n uint8_t bytes[4];\n\n if (!fread(bytes, sizeof(uint8_t), 4, m_file)) {\n return false;\n }\n\n *value = ((uint32_t)bytes[3] << 24) | ((uint32_t)bytes[2] << 16) |\n ((uint32_t)bytes[1] << 8) | (uint32_t)bytes[0];\n\n return true;\n}\n\nbool BinaryInput::read_uint64(uint64_t * value)\n{\n uint8_t bytes[8];\n\n if (!fread(bytes, sizeof(uint8_t), 8, m_file)) {\n return false;\n }\n\n *value = ((uint64_t)bytes[7] << 56) | ((uint64_t)bytes[6] << 48) |\n ((uint64_t)bytes[5] << 40) | ((uint64_t)bytes[4] << 32) |\n ((uint64_t)bytes[3] << 24) | ((uint64_t)bytes[2] << 16) |\n ((uint64_t)bytes[1] << 8) | (uint64_t)bytes[0];\n\n return true;\n}\n\nOptional BinaryInput::read_len_string(GCCapability & gc_cap)\n{\n uint16_t len;\n\n if (!read_uint16(&len)) {\n return Optional::Nothing();\n }\n return read_string(gc_cap, len);\n}\n\nOptional BinaryInput::read_string(GCCapability & gc_cap, uint16_t len)\n{\n FlatString *str;\n\n str = FlatString::New(gc_cap, len);\n if (len != fread(str->buffer(), sizeof(char), len, m_file)) {\n return Optional::Nothing();\n }\n str->buffer()[len] = 0;\n\n return Optional(String(str));\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_io.h", "content": "/*\n * IO Utils.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef IO_UTILS_H\n#define IO_UTILS_H\n\n#include \n\n#include \"pz_cxx_future.h\"\n#include \"pz_gc_util.h\"\n#include \"pz_string.h\"\n\nnamespace pz {\n\n/*\n * A binary input file, this is a wrapper around a FILE pointer. Internally\n * we use the C API rather than C++ since the C one is simple to use for\n * binary data.\n *\n * Since it wraps the C FILE structure a failing operation will set errno.\n * Callers should check errno directly.\n */\nclass BinaryInput\n{\n private:\n FILE * m_file;\n std::string m_filename;\n\n public:\n BinaryInput() : m_file(nullptr), m_filename() {}\n\n /*\n * For normal/happy paths, you must call close() before the destructor\n * runs. The destructor will treat the file being open as an error and\n * report information about the file's state.\n */\n ~BinaryInput();\n\n /*\n * Open a file.\n */\n bool open(const std::string & filename);\n\n /*\n * Close the file.\n */\n void close();\n\n /*\n * The current file's name.\n */\n const std::string & filename() const;\n const char * filename_c() const;\n\n /*\n * Read an 8bit unsigned integer.\n */\n bool read_uint8(uint8_t * value);\n\n /*\n * Read a 16bit unsigned integer.\n */\n bool read_uint16(uint16_t * value);\n\n /*\n * Read a 32bit unsigned integer.\n */\n bool read_uint32(uint32_t * value);\n\n /*\n * Read a 64bit unsigned integer.\n */\n bool read_uint64(uint64_t * value);\n\n /*\n * Read a length (16 bits) followed by a string of that length.\n */\n Optional read_len_string(GCCapability & gc_cap);\n\n /*\n * Read a string of the given length from the stream.\n */\n Optional read_string(GCCapability & gc_cap, uint16_t len);\n\n /*\n * seek relative to beginning of file.\n */\n bool seek_set(long pos);\n\n /*\n * seek relative to current position.\n */\n bool seek_cur(long pos);\n\n Optional tell() const;\n\n bool is_at_eof();\n\n BinaryInput(const BinaryInput &) = delete;\n void operator=(const BinaryInput &) = delete;\n};\n\n} // namespace pz\n\n#endif /* ! IO_UTILS_H */\n" }, { "path": "runtime/pz_library.cpp", "content": "/*\n * Plasma in-memory representation\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n#include \n#include \n\n#include \"pz_closure.h\"\n#include \"pz_util.h\"\n\n#include \"pz_library.h\"\n\nnamespace pz {\n\n/*\n * LibraryLoading class\n **********************/\n\nLibraryLoading::LibraryLoading(unsigned num_structs,\n unsigned num_data, unsigned num_procs,\n unsigned num_closures, NoGCScope & no_gc)\n : m_total_code_size(0)\n{\n m_structs.reserve(num_structs);\n m_datas.reserve(num_data);\n m_procs.reserve(num_procs);\n m_closures.reserve(num_closures);\n for (unsigned i = 0; i < num_closures; i++) {\n m_closures.push_back(new (no_gc) Closure());\n }\n}\n\nStruct * LibraryLoading::new_struct(unsigned num_fields,\n GCCapability & gc_cap)\n{\n NoGCScope nogc(gc_cap);\n\n Struct * struct_ = new (nogc) Struct(nogc, num_fields);\n if (nogc.is_oom()) return nullptr;\n\n m_structs.push_back(struct_);\n return struct_;\n}\n\nvoid LibraryLoading::add_data(void * data)\n{\n m_datas.push_back(data);\n}\n\nProc * LibraryLoading::new_proc(String name, unsigned size, bool is_builtin,\n GCCapability & gc_cap)\n{\n // Either the proc object, or the code area within it are untracable\n // while the proc is constructed.\n NoGCScope no_gc(gc_cap);\n\n Proc * proc = new (no_gc) Proc(no_gc, name, is_builtin, size);\n if (no_gc.is_oom()) return nullptr;\n\n m_procs.push_back(proc);\n m_total_code_size += proc->size();\n return proc;\n}\n\nvoid LibraryLoading::add_symbol(String name, Closure * closure)\n{\n m_symbols.insert(std::make_pair(name, closure));\n}\n\nvoid LibraryLoading::print_loaded_stats() const\n{\n printf(\"Loaded %d procedures with a total of %d bytes.\\n\",\n num_procs(),\n m_total_code_size);\n}\n\nvoid LibraryLoading::do_trace(HeapMarkState * marker) const\n{\n /*\n * This is needed in case we GC during loading, we want to keep this\n * module until we know we're done loading it.\n */\n for (Struct * s : m_structs) {\n marker->mark_root(s);\n }\n\n for (void * d : m_datas) {\n marker->mark_root(d);\n }\n\n for (void * p : m_procs) {\n marker->mark_root(p);\n }\n\n for (void * c : m_closures) {\n marker->mark_root(c);\n }\n\n for (auto symbol : m_symbols) {\n marker->mark_root(symbol.first.ptr());\n marker->mark_root(symbol.second);\n }\n}\n\n/*\n * Library class\n ***************/\n\nLibrary::Library() : m_entry_closure(nullptr) {}\n\nLibrary::Library(LibraryLoading & loading)\n : m_symbols(loading.m_symbols)\n , m_entry_closure(nullptr)\n{}\n\nvoid Library::add_symbol(String name, Closure * closure)\n{\n m_symbols.insert(std::make_pair(name, closure));\n}\n\nOptional Library::lookup_symbol(String name) const\n{\n auto iter = m_symbols.find(name);\n\n if (iter != m_symbols.end()) {\n return iter->second;\n } else {\n return Optional::Nothing();\n }\n}\n\nvoid Library::do_trace(HeapMarkState * marker) const\n{\n for (auto symbol : m_symbols) {\n marker->mark_root(symbol.first.ptr());\n marker->mark_root(symbol.second);\n }\n\n marker->mark_root(m_entry_closure);\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_library.h", "content": "/*\n * Plasma in-memory representation (modules)\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_LIBRARY_H\n#define PZ_LIBRARY_H\n\n#include \"pz_common.h\"\n\n#include \n\n#include \"pz_closure.h\"\n#include \"pz_code.h\"\n#include \"pz_data.h\"\n#include \"pz_gc_util.h\"\n\nnamespace pz {\n\n/*\n * This class tracks all the information we need to load a library, since\n * loading also includes linking. Once that's complete a lot of this can be\n * dropped and only the exported symbols need to be kept (anything they\n * point to will be kept by the GC).\n */\nclass LibraryLoading : public GCNewTrace\n{\n private:\n std::vector m_structs;\n\n std::vector m_datas;\n\n std::vector m_procs;\n unsigned m_total_code_size;\n\n std::vector m_closures;\n\n std::unordered_map m_symbols;\n\n friend class Library;\n\n public:\n LibraryLoading(unsigned num_structs,\n unsigned num_data,\n unsigned num_procs,\n unsigned num_closures,\n NoGCScope &no_gc);\n\n const Struct * struct_(unsigned id) const\n {\n return m_structs.at(id);\n }\n\n Struct * new_struct(unsigned num_fields, GCCapability & gc_cap);\n\n void * data(unsigned id) const\n {\n return m_datas.at(id);\n }\n\n void add_data(void * data);\n\n unsigned num_procs() const\n {\n return m_procs.size();\n }\n\n const Proc * proc(unsigned id) const\n {\n return m_procs.at(id);\n }\n Proc * proc(unsigned id)\n {\n return m_procs.at(id);\n }\n\n Proc * new_proc(String name, unsigned size, bool is_builtin,\n GCCapability & gc_cap);\n\n Closure * closure(unsigned id) const\n {\n return m_closures.at(id);\n }\n\n void add_symbol(String name, Closure * closure);\n\n void print_loaded_stats() const;\n\n LibraryLoading(LibraryLoading & other) = delete;\n void operator=(LibraryLoading & other) = delete;\n\n void do_trace(HeapMarkState * marker) const override;\n};\n\nclass Library : public GCNewTrace\n{\n private:\n std::unordered_map m_symbols;\n PZOptEntrySignature m_entry_signature;\n Closure * m_entry_closure;\n\n public:\n Library();\n Library(LibraryLoading & loading);\n\n Closure * entry_closure() const\n {\n return m_entry_closure;\n }\n PZOptEntrySignature entry_signature() const\n {\n return m_entry_signature;\n }\n\n void set_entry_closure(PZOptEntrySignature sig, Closure * clo)\n {\n m_entry_signature = sig;\n m_entry_closure = clo;\n }\n\n /*\n * Symbol names are fully qualified, since one Module class (which\n * really represents a library) may contain more than one modules.\n */\n void add_symbol(String name, Closure * closure);\n\n Optional lookup_symbol(String name) const;\n\n void do_trace(HeapMarkState * marker) const override;\n\n Library(Library & other) = delete;\n void operator=(Library & other) = delete;\n};\n\n} // namespace pz\n\n#endif // ! PZ_LIBRARY_H\n" }, { "path": "runtime/pz_main.cpp", "content": "/*\n * Plasma bytecode execution\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n *\n * This program executes plasma bytecode.\n */\n\n#include \n\n#include \"pz_common.h\"\n\n#include \"pz.h\"\n#include \"pz_builtin.h\"\n#include \"pz_gc.h\"\n#include \"pz_gc.impl.h\"\n#include \"pz_interp.h\"\n#include \"pz_option.h\"\n#include \"pz_read.h\"\n#include \"pz_util.h\"\n\nusing namespace pz;\n\nstatic int run(Options & options);\n\nstatic void help(const char * progname, FILE * stream);\n\nstatic void version(void);\n\nint main(int argc, char * const argv[])\n{\n Options options;\n\n Options::Mode mode = options.parse(argc, argv);\n switch (mode) {\n case Options::Mode::HELP:\n help(argv[0], stdout);\n return EXIT_SUCCESS;\n case Options::Mode::VERSION:\n version();\n return EXIT_SUCCESS;\n case Options::Mode::ERROR:\n if (options.error_message()) {\n fprintf(stderr, \"%s: %s\\n\", argv[0], options.error_message());\n }\n help(argv[0], stderr);\n return EXIT_FAILURE;\n case Options::Mode::NORMAL:\n return run(options);\n }\n}\n\nstatic bool setup_program(PZ & pz, Options & options, GCCapability & gc);\n\nstatic int run(Options & options)\n{\n MemoryBase::init_statics();\n Heap heap(options);\n\n if (!heap.init()) {\n fprintf(stderr, \"Couldn't initialise memory.\\n\");\n return PZ_EXIT_RUNTIME_ERROR;\n }\n int retcode = 0;\n ScopeExit finalise([&heap, &options, &retcode] {\n if (!heap.finalise(options.fast_exit())) {\n if (retcode == 0) {\n retcode = PZ_EXIT_RUNTIME_NONFATAL;\n }\n }\n });\n\n PZ pz(options, heap);\n heap.set_roots_tracer(pz);\n GCThreadHandle gc(heap);\n\n if (setup_program(pz, options, gc)) {\n int program_retcode = run(pz, options, gc);\n retcode = program_retcode ? program_retcode : retcode;\n } else {\n retcode = PZ_EXIT_RUNTIME_ERROR;\n }\n\n return retcode;\n}\n\nstatic void split_filenames(const std::string & filenames,\n std::string & bytecode, Optional & native) \n{\n size_t pos = filenames.find_first_of(':');\n if (pos == std::string::npos) {\n bytecode = filenames;\n native = Optional();\n } else {\n bytecode = filenames.substr(0, pos);\n native = Optional(filenames.substr(pos+1));\n }\n}\n\nstatic bool setup_program(PZ & pz, Options & options, GCCapability & gc0)\n{\n GCTracer gc(gc0);\n Library * builtins = pz.new_library(String(\"Builtin\"), gc);\n setup_builtins(builtins, pz);\n\n for (const std::string & filenames : options.pzlibs()) {\n std::string bytecode_filename;\n Optional native_filename;\n split_filenames(filenames, bytecode_filename, native_filename);\n Root> names(gc);\n {\n NoGCScope no_gc(gc);\n names = new(no_gc) Vector(no_gc);\n no_gc.abort_if_oom(\"setup_program\");\n }\n Root lib(gc);\n if (!read(pz, bytecode_filename, native_filename, lib, \n names.ptr(), gc))\n {\n return false;\n }\n for (auto& name : names.get()) {\n pz.add_library(name, lib.ptr());\n }\n }\n\n Root program(gc);\n std::string bytecode_filename;\n Optional native_filename;\n split_filenames(options.pzfile(), bytecode_filename, native_filename);\n if (!read(pz, bytecode_filename, native_filename, program,\n nullptr, gc))\n {\n return false;\n }\n\n pz.add_program_lib(program.ptr());\n return true;\n}\n\nstatic void help(const char * progname, FILE * stream)\n{\n fprintf(stream, \"Plasma runtime\\n\\n\");\n fprintf(stream, \" Run plasma bytecode programs\\n\\n\");\n fprintf(stream, \"Usage:\\n\\n\");\n fprintf(stream, \" %s [-v] (-l ) \\n\",\n progname);\n fprintf(stream, \" %s -h\\n\", progname);\n fprintf(stream, \" %s -V\\n\\n\", progname);\n fprintf(stream, \"Options:\\n\\n\");\n fprintf(stream, \" -h Show the help message (this one).\\n\");\n fprintf(stream, \" -V Show version information.\\n\");\n fprintf(stream, \" -v Verbose bytecode loading.\\n\");\n fprintf(stream, \" -l Dynamic link this bytecode library.\\n\\n\");\n}\n\nstatic void version(void)\n{\n printf(\"Plasma Runtime, \" PLASMA_VERSION_STRING \"\\n\");\n printf(\"https://plasmalang.org\\n\");\n printf(\"Copyright (C) 2015-2025 The Plasma Team\\n\");\n printf(\"Distributed under the MIT License\\n\");\n}\n" }, { "path": "runtime/pz_memory.cpp", "content": "/*\n * Plasma large memory region allocation\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n#include \n#include \n#include \n#include \n\n#include \"pz_memory.h\"\n\nsize_t MemoryBase::s_page_size = 0;\nMemoryBase* MemoryBase::s_root = nullptr;\n\nstatic void handler(int sig, siginfo_t *info, void *ucontext) {\n fprintf(stderr, \"Caught signal \");\n switch (sig) {\n case SIGSEGV:\n fprintf(stderr, \"SEGV\");\n break;\n case SIGBUS:\n fprintf(stderr, \"BUS\");\n break;\n default:\n fprintf(stderr, \"%d.\\n\", sig);\n return;\n }\n fprintf(stderr, \" for address %p\\n\", info->si_addr);\n\n MemoryBase * zone = MemoryBase::search(info->si_addr);\n if (zone) {\n zone->fault_handler(info->si_addr);\n } else {\n fprintf(stderr,\n \"The Plasma runtime doesn't know about this memory region.\\n\");\n exit(PZ_EXIT_RUNTIME_ERROR);\n }\n}\n\nvoid MemoryBase::fault_handler(void * fault_addr) {\n const char * juxt;\n InZone in = is_in(fault_addr);\n switch (in) {\n case IZ_WITHIN:\n juxt = \"within\";\n break;\n case IZ_GUARD_BEFORE:\n juxt = \"in the guard page before\";\n break;\n case IZ_GUARD_AFTER:\n juxt = \"in the guard page after\";\n break;\n case IZ_BEFORE:\n case IZ_AFTER:\n fprintf(stderr, \"Fault is not in this zone (bad search result?)\\n\");\n abort();\n }\n fprintf(stderr, \"The fault occured %s the %s region (%p - %p)\\n\",\n juxt, name(), first_address(), last_address());\n\n if (is_stack() && in == IZ_GUARD_AFTER) {\n fprintf(stderr, \"This is probably caused by unbounded recursion causing \"\n \"a stack overrun\\n\");\n } else if (is_stack() && in == IZ_GUARD_BEFORE) {\n fprintf(stderr, \"This could be a stack underrun, \"\n \"which is probably caused by a bug in the compiler\");\n }\n\n exit(PZ_EXIT_RUNTIME_ERROR);\n}\n\nMemoryBase::InZone MemoryBase::is_in(void * fault_addr) const {\n assert(s_page_size);\n\n void * guard_before;\n void * last_addr_plus_1 = reinterpret_cast(\n reinterpret_cast(m_pointer) + m_size);\n void * guard_after;\n if (m_has_guards) {\n guard_before = reinterpret_cast(\n reinterpret_cast(m_pointer) - s_page_size);\n guard_after = reinterpret_cast(\n reinterpret_cast(last_addr_plus_1) + s_page_size);\n } else {\n guard_before = m_pointer;\n guard_after = last_addr_plus_1;\n }\n\n assert(guard_before <= m_pointer);\n assert(m_pointer < last_addr_plus_1);\n assert(last_addr_plus_1 <= guard_after);\n\n if (fault_addr < guard_before) {\n return IZ_BEFORE;\n } else if (fault_addr < m_pointer) {\n return IZ_GUARD_BEFORE;\n } else if (fault_addr < last_addr_plus_1) {\n return IZ_WITHIN;\n } else if (fault_addr < guard_after) {\n return IZ_GUARD_AFTER;\n } else {\n return IZ_AFTER;\n }\n}\n\n// Ignores errors, because they're not fatal.\nstatic void setup_handler(int signal) {\n struct sigaction action;\n memset(&action, 0, sizeof(action));\n action.sa_sigaction = handler;\n sigemptyset(&action.sa_mask);\n sigaddset(&action.sa_mask, SIGSEGV);\n sigaddset(&action.sa_mask, SIGBUS);\n action.sa_flags = SA_SIGINFO;\n\n if (0 != sigaction(signal, &action, nullptr)) {\n perror(\"sigaction\");\n }\n}\n\nvoid\nMemoryBase::init_statics() {\n if (s_page_size) {\n // Init is already done.\n return;\n }\n\n s_page_size = sysconf(_SC_PAGESIZE);\n\n setup_handler(SIGSEGV);\n setup_handler(SIGBUS);\n}\n\nbool\nMemoryBase::allocate(size_t size, bool guarded) {\n assert(s_page_size);\n\n size_t mmap_size = size;\n if (guarded) {\n mmap_size += s_page_size * 2;\n }\n\n void *ptr = mmap(NULL, mmap_size, PROT_READ | PROT_WRITE,\n MAP_PRIVATE | MAP_ANONYMOUS, -1, 0);\n\n if (MAP_FAILED == ptr) {\n return false;\n }\n\n if (guarded) {\n void * guard_address_1 = ptr;\n void * guard_address_2 = reinterpret_cast(\n reinterpret_cast(ptr) + s_page_size + size);\n ptr = reinterpret_cast(\n reinterpret_cast(ptr) + s_page_size);\n\n if (0 != mprotect(guard_address_1, s_page_size, PROT_NONE)) {\n return false;\n }\n if (0 != mprotect(guard_address_2, s_page_size, PROT_NONE)) {\n return false;\n }\n }\n\n m_pointer = ptr;\n m_size = size;\n m_has_guards = guarded;\n\n insert();\n\n return true;\n}\n\nbool\nMemoryBase::release() {\n if (m_pointer) {\n remove();\n\n void *ptr = m_pointer;\n size_t size = m_size;\n if (m_has_guards) {\n ptr = reinterpret_cast(\n reinterpret_cast(m_pointer) - s_page_size);\n size = m_size + s_page_size*2;\n }\n if (-1 == munmap(ptr, size)) {\n perror(\"munmap\");\n return false;\n }\n m_pointer = nullptr;\n }\n\n return true;\n}\n\nvoid\nMemoryBase::forget() {\n if (m_pointer) {\n remove();\n m_pointer = nullptr;\n }\n}\n\nMemoryBase*\nMemoryBase::search(void * addr) {\n MemoryBase * cur = s_root;\n\n while (cur) {\n cur->check_node();\n\n switch (cur->is_in(addr)) {\n case IZ_BEFORE:\n cur = cur->m_left;\n continue;\n case IZ_AFTER:\n cur = cur->m_right;\n continue;\n case IZ_WITHIN:\n case IZ_GUARD_BEFORE:\n case IZ_GUARD_AFTER:\n return cur;\n }\n }\n\n return nullptr;\n}\n\nvoid\nMemoryBase::insert() {\n MemoryBase **here = &s_root;\n MemoryBase *cur = s_root;\n MemoryBase *prev = nullptr;\n\n while (cur) {\n cur->check_node();\n\n switch (cur->is_in(this->m_pointer)) {\n case IZ_BEFORE:\n prev = cur;\n here = &cur->m_left;\n cur = cur->m_left;\n continue;\n case IZ_AFTER:\n prev = cur;\n here = &cur->m_right;\n cur = cur->m_right;\n continue;\n case IZ_WITHIN:\n case IZ_GUARD_BEFORE:\n case IZ_GUARD_AFTER:\n fprintf(stderr, \"Duplicate map\\n\");\n abort();\n }\n }\n\n *here = this;\n m_parent = prev;\n check_node();\n}\n\nvoid\nMemoryBase::remove() {\n check_node();\n\n MemoryBase **here;\n if (m_parent) {\n if (m_parent->m_left == this) {\n here = &m_parent->m_left;\n } else {\n here = &m_parent->m_right;\n }\n } else {\n here = &s_root;\n }\n\n if (!m_left && !m_right) {\n // A leaf node can be removed simply.\n *here = nullptr;\n } else if (!m_left && m_right) {\n // A node with only one child can be removed by replacing it with\n // its child.\n *here = m_right;\n m_right->m_parent = m_parent;\n } else if (m_left && !m_right) {\n // Ditto.\n *here = m_left;\n m_left->m_parent = m_parent;\n } else {\n // Find a node we can replace this node with.\n MemoryBase *cur = m_left;\n while (cur->m_right) {\n cur = cur->m_right;\n }\n\n // cur has no right branch, we can remove it from its position\n // easily.\n cur->remove();\n\n // Now replace this with cur.\n cur->m_parent = m_parent;\n *here = cur;\n cur->m_left = m_left;\n cur->m_right = m_right;\n\n // Fix the backlinks\n assert(cur != this); // We'd have entered one of te branches above\n // if this were ==\n if (m_parent) {\n if (m_parent->m_left == this) {\n m_parent->m_left = cur;\n } else {\n assert(m_parent->m_right == this);\n m_parent->m_right = cur;\n }\n }\n assert(m_left->m_parent == this);\n m_left->m_parent = cur;\n assert(m_right->m_parent == this);\n m_right->m_parent = cur;\n\n cur->check_node();\n }\n\n m_parent = nullptr;\n m_left = nullptr;\n m_right = nullptr;\n}\n\nvoid MemoryBase::check_node() {\n if (!m_pointer) {\n assert(!m_left);\n assert(!m_right);\n assert(!m_parent);\n return;\n }\n\n // This is only called for a node in the tree, which means there is\n // always a non-null root node.\n assert(s_root);\n\n if (m_parent) {\n // check the relationship with our parent.\n assert(s_root != this);\n if (m_parent->m_left == this) {\n assert(m_parent->m_right != this);\n assert(m_pointer <= m_parent->m_pointer);\n } else {\n assert(m_parent->m_right == this);\n assert(m_parent->m_left != this);\n assert(m_parent->m_pointer <= m_pointer);\n }\n } else {\n assert(s_root == this);\n }\n\n if (m_left) {\n assert(m_left->m_parent == this);\n assert(m_left->m_pointer <= m_pointer);\n }\n if (m_right) {\n assert(m_right->m_parent == this);\n assert(m_pointer <= m_right->m_pointer);\n }\n}\n\n" }, { "path": "runtime/pz_memory.h", "content": "/*\n * Plasma large memory region allocation\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_MEMORY_H\n#define PZ_MEMORY_H\n\n#include \n\nclass MemoryBase {\n // Static stuff:\n private:\n static size_t s_page_size;\n\n public:\n static void init_statics();\n\n // Per memory-mapping stuff:\n private:\n const char * m_name;\n void * m_pointer = nullptr;\n size_t m_size = 0;\n bool m_has_guards = false;\n\n // Memory mappings are arranged in a tree for signal handlers to find\n // them.\n MemoryBase * m_left = nullptr;\n MemoryBase * m_right = nullptr;\n MemoryBase * m_parent = nullptr;\n static MemoryBase * s_root;\n\n public:\n static MemoryBase * search(void * pointer);\n\n private:\n void insert();\n void remove();\n void check_node();\n\n public:\n MemoryBase(const char * name) : m_name(name) {}\n ~MemoryBase() {\n release();\n }\n\n bool is_mapped() const {\n return !!m_pointer;\n }\n\n protected:\n bool allocate(size_t size, bool guard);\n\n void * raw_pointer() const {\n return m_pointer;\n }\n\n public:\n // Release the memory back to the OS\n bool release();\n\n // Forget the memory mapping, much faster, very leaky.\n void forget();\n\n MemoryBase(MemoryBase && other) = delete;\n MemoryBase(const MemoryBase & other) = delete;\n void operator=(MemoryBase && other) = delete;\n void operator=(const MemoryBase & other) = delete;\n\n enum InZone {\n IZ_BEFORE,\n IZ_AFTER,\n IZ_WITHIN,\n IZ_GUARD_BEFORE,\n IZ_GUARD_AFTER,\n };\n\n // Describe where this memory address lies compared with the mapped\n // memory region.\n InZone is_in(void * addr) const;\n\n void fault_handler(void * fault_addr);\n\n const char * name() const {\n return m_name;\n }\n\n void * first_address() const {\n return m_pointer;\n }\n\n void * last_address() const {\n if (m_pointer) {\n return reinterpret_cast(\n reinterpret_cast(m_pointer) + m_size - 1);\n } else {\n return nullptr;\n }\n }\n\n bool is_stack() const {\n // For now the only memory regions with guard pages are stacks.\n return m_has_guards;\n }\n};\n\n/*\n * A memory region, the address of the region is the pointer to Memory\n * itself,\n */\ntemplate\nclass Memory : public MemoryBase {\n public:\n Memory(const char *name) : MemoryBase(name) {}\n\n bool allocate(size_t size = sizeof(T)) {\n return MemoryBase::allocate(size, false);\n }\n\n // Allocate with guard pages before and after the allocation.\n bool allocate_guarded(size_t size = sizeof(T)) {\n return MemoryBase::allocate(size, true);\n }\n\n T * ptr() {\n return reinterpret_cast(raw_pointer());\n }\n const T * ptr() const {\n return reinterpret_cast(raw_pointer());\n }\n T * operator->() {\n return ptr();\n }\n const T * operator->() const {\n return ptr();\n }\n\n typedef typename std::remove_all_extents::type Elem;\n Elem& operator[](unsigned i) {\n return reinterpret_cast(ptr())[i];\n }\n};\n\n#endif /* ! PZ_MEMORY_H */\n\n" }, { "path": "runtime/pz_option.cpp", "content": "/*\n * Plasma bytecode execution\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \"pz_common.h\"\n\n#include \n#include \n\n// ??\n#include \n\n#include \"pz_option.h\"\n\nnamespace pz {\n\nOptions::Mode Options::parse(int argc, char * const argv[])\n{\n m_error_message = nullptr;\n Mode mode = parseCommandLine(argc, argv);\n\n if (mode == Mode::ERROR) return Mode::ERROR;\n\n parseEnvironment();\n\n return mode;\n}\n\n#ifdef _GNU_SOURCE\n// Request POSIX behaviour\n#define OPTSTRING \"+hl:vV\"\n#else\n#define OPTSTRING \"hl:vV\"\n#endif\n\nOptions::Mode Options::parseCommandLine(int argc, char * const argv[])\n{\n int option = getopt(argc, argv, OPTSTRING);\n while (option != -1) {\n switch (option) {\n case 'h':\n return Mode::HELP;\n case 'l':\n m_pzlibs.emplace_back(optarg);\n break;\n case 'V':\n return Mode::VERSION;\n case 'v':\n m_verbose = true;\n break;\n case '?':\n return Mode::ERROR;\n }\n option = getopt(argc, argv, OPTSTRING);\n }\n\n if (optind < argc) {\n m_pzfile = argv[optind];\n } else {\n m_error_message = \"Expected one PZB file to execute\";\n return Mode::ERROR;\n }\n\n return Mode::NORMAL;\n}\n\nvoid Options::parseEnvironment()\n{\n if (char * opts = getenv(\"PZ_RUNTIME_OPTS\")) {\n opts = strdup(opts);\n char * strtok_save;\n\n const char * token = strtok_r(opts, \",\", &strtok_save);\n while (token) {\n if (strcmp(token, \"load_verbose\") == 0) {\n m_verbose = true;\n } else if (strncmp(token, \"fast_exit\", 9) == 0) {\n if (token[9] == '=') {\n if (strcmp(&token[10], \"yes\") == 0) {\n m_fast_exit = true;\n } else if (strcmp(&token[10], \"no\") == 0) {\n m_fast_exit = false;\n } else {\n fprintf(\n stderr,\n \"PZ_RUNTIME_OPTS option fast_exit bad parameter \"\n \"'%s', expected 'yes' or 'no'.\\n\",\n &token[10]);\n }\n } else {\n fprintf(stderr,\n \"PZ_RUNTIME_OPTS \"\n \"option fast_exit requires a parameter\\n\");\n }\n } else {\n // This warning is non-fatal, so it doesn't set the\n // error_message_ property or return ERROR.\n fprintf(stderr,\n \"Warning: Unknown PZ_RUNTIME_OPTS option: %s\\n\",\n token);\n }\n token = strtok_r(nullptr, \",\", &strtok_save);\n }\n\n free(opts);\n }\n\n#ifdef PZ_DEV\n if (char * opts = getenv(\"PZ_RUNTIME_DEV_OPTS\")) {\n opts = strdup(opts);\n char * strtok_save;\n\n const char * token = strtok_r(opts, \",\", &strtok_save);\n while (token) {\n if (strcmp(token, \"interp_trace\") == 0) {\n m_interp_trace = true;\n } else if (strcmp(token, \"gc_zealous\") == 0) {\n m_gc_zealous = true;\n } else if (strcmp(token, \"gc_usage_stats\") == 0) {\n m_gc_usage_stats = true;\n } else if (strcmp(token, \"gc_trace\") == 0) {\n m_gc_trace = true;\n } else {\n // This warning is non-fatal, so it doesn't set the\n // error_message_ property or return ERROR.\n fprintf(stderr,\n \"Warning: Unknown PZ_RUNTIME_DEV_OPTS option: %s\\n\",\n token);\n }\n token = strtok_r(nullptr, \",\", &strtok_save);\n }\n\n free(opts);\n }\n#endif\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_option.h", "content": "/*\n * Plasma runtime options\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_OPTIONS_H\n#define PZ_OPTIONS_H\n\n#include \n#include \n\nnamespace pz {\n\n/*\n * Runtime options\n *\n * Options are specified by environment variable, see README.md in this\n * directory for the list of configurable options.\n *\n * Not all options may be specified, some are compiled in as can be seen in\n * their accessor functions below.\n *\n * TODO: probably integrate options that can change at runtime with this\n * class, such as the GC size.\n */\nclass Options\n{\n public:\n enum Mode {\n NORMAL,\n HELP,\n VERSION,\n ERROR,\n };\n\n private:\n std::string m_pzfile;\n std::vector m_pzlibs;\n bool m_verbose;\n bool m_fast_exit;\n\n#ifdef PZ_DEV\n bool m_interp_trace;\n bool m_gc_zealous;\n bool m_gc_usage_stats;\n bool m_gc_trace;\n#endif\n\n // Non-null if parse returns Mode::ERROR\n const char * m_error_message;\n\n Mode parseCommandLine(int artc, char * const argv[]);\n void parseEnvironment();\n\n public:\n Options()\n : m_verbose(false)\n#ifndef PZ_DEV\n , m_fast_exit(true)\n#else\n , m_fast_exit(false)\n , m_interp_trace(false)\n , m_gc_zealous(false)\n , m_gc_usage_stats(false)\n , m_gc_trace(false)\n#endif\n {}\n\n Mode parse(int artc, char * const argv[]);\n\n /*\n * Non-null if parse made an error message available. Even if an error\n * occurs, sometimes getopt will print the error message and this will\n * be null.\n */\n const char * error_message() const\n {\n return m_error_message;\n }\n\n bool verbose() const\n {\n return m_verbose;\n }\n std::string pzfile() const\n {\n return m_pzfile;\n }\n const std::vector & pzlibs() const\n {\n return m_pzlibs;\n }\n bool fast_exit() const\n {\n return m_fast_exit;\n }\n\n#ifdef PZ_DEV\n bool interp_trace() const\n {\n return m_interp_trace;\n }\n bool gc_zealous() const\n {\n return m_gc_zealous;\n }\n bool gc_usage_stats() const\n {\n return m_gc_usage_stats;\n }\n\n // In the future make these false by default and allow them to be\n // changed at runtime.\n bool gc_slow_asserts() const\n {\n return true;\n }\n bool gc_poison() const\n {\n return true;\n }\n\n // Change temporarily to enable tracing.\n bool gc_trace() const\n {\n return m_gc_trace;\n }\n bool gc_trace2() const\n {\n return false;\n }\n#else\n bool interp_trace() const\n {\n return false;\n }\n#endif\n\n Options(const Options &) = delete;\n void operator=(const Options &) = delete;\n};\n\n} // namespace pz\n\n#endif\n" }, { "path": "runtime/pz_read.cpp", "content": "/*\n * Plasma bytecode reader\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \n#include \n\n#include \"pz_common.h\"\n\n#include \"pz.h\"\n#include \"pz_closure.h\"\n#include \"pz_code.h\"\n#include \"pz_data.h\"\n#include \"pz_foreign.h\"\n#include \"pz_format.h\"\n#include \"pz_interp.h\"\n#include \"pz_io.h\"\n#include \"pz_read.h\"\n#include \"pz_string.h\"\n#include \"pz_util.h\"\n\nnamespace pz {\n\nstruct Imported : public GCNewTrace {\n Imported(unsigned num_imports)\n {\n import_closures.reserve(num_imports);\n }\n\n std::vector import_closures;\n\n size_t num_imports() const {\n return import_closures.size();\n }\n\n void do_trace(HeapMarkState * marker) const override {\n for (Closure *c : import_closures) {\n marker->mark_root(c);\n }\n }\n};\n\nstruct ReadInfo {\n PZ & pz;\n BinaryInput file;\n bool verbose;\n bool load_debuginfo;\n\n ReadInfo(PZ & pz_)\n : pz(pz_)\n , verbose(pz.options().verbose())\n , load_debuginfo(pz.options().interp_trace())\n {}\n};\n\n/*\n * The closure id and signature type for the program's entrypoint\n */\nstruct EntryClosure {\n PZOptEntrySignature signature;\n uint32_t closure_id;\n\n EntryClosure(PZOptEntrySignature sig, uint32_t clo)\n : signature(sig)\n , closure_id(clo)\n {}\n};\n\nstatic bool\nread_options(BinaryInput &file, Optional &entry_closure);\n\nstatic bool\nread_imports(ReadInfo &read,\n unsigned num_imports,\n Imported *imported,\n const Foreign *foreign,\n GCTracer &gc);\n\nstatic bool\nread_structs(ReadInfo &read,\n unsigned num_structs,\n LibraryLoading *library,\n GCCapability &gc);\n\nstatic bool\nread_data(ReadInfo &read,\n unsigned num_datas,\n LibraryLoading *library,\n Imported *imports,\n GCCapability &gc);\n\nstatic Optional\nread_data_width(BinaryInput &file);\n\nstatic bool\nread_data_slot(ReadInfo &read,\n enum pz_data_enc_type type,\n uint8_t enc_width,\n void *dest,\n LibraryLoading *library,\n Imported *imports);\n\nstatic bool\nread_code(ReadInfo &read,\n unsigned num_procs,\n LibraryLoading *library,\n Imported *imported,\n GCCapability &gc);\n\nstatic unsigned\nread_proc(ReadInfo &read,\n Imported *imported,\n LibraryLoading *library,\n Proc *proc, /* null for first pass */\n unsigned **block_offsets,\n GCCapability &gc);\n\nstatic bool\nread_instr(BinaryInput &file,\n Imported *imported,\n LibraryLoading *library,\n uint8_t *proc_code,\n unsigned **block_offsets,\n unsigned &proc_offset);\n\nstatic bool\nread_meta(ReadInfo &read,\n LibraryLoading *library,\n Proc *proc,\n unsigned proc_offset,\n uint8_t meta_byte,\n GCCapability &gc);\n\nstatic bool\nread_closures(ReadInfo &read,\n unsigned num_closures,\n Imported *imported,\n LibraryLoading *library);\n\nstatic bool\nread_exports(ReadInfo &read,\n unsigned num_exports,\n LibraryLoading *library,\n GCTracer &gc);\n\nbool\nread(PZ &pz, const std::string &bytecode_filename,\n const Optional &native_filename, Root &library,\n Vector * names, GCTracer &gc)\n{\n ReadInfo read(pz);\n uint32_t magic;\n uint16_t version;\n uint32_t num_imports;\n uint32_t num_structs;\n uint32_t num_datas;\n uint32_t num_procs;\n uint32_t num_closures;\n uint32_t num_exports;\n\n if (!read.file.open(bytecode_filename)) {\n perror(bytecode_filename.c_str());\n return false;\n }\n\n if (!read.file.read_uint32(&magic)) return false;\n switch (magic) {\n case PZ_OBJECT_MAGIC_NUMBER:\n fprintf(stderr,\n \"%s: Cannot execute plasma objects, \"\n \"link objects into a program first.\\n\",\n bytecode_filename.c_str());\n return false;\n case PZ_PROGRAM_MAGIC_NUMBER:\n case PZ_LIBRARY_MAGIC_NUMBER:\n break; // good, we continue\n default:\n fprintf(stderr,\n \"%s: bad magic value, is this a PZ file?\\n\",\n bytecode_filename.c_str());\n return false;\n }\n\n {\n Optional mb_string = read.file.read_len_string(gc);\n if (!mb_string.hasValue()) return false;\n RootString string(gc, mb_string.release());\n if (!string.startsWith(String(PZ_PROGRAM_MAGIC_STRING), gc) &&\n !string.startsWith(String(PZ_LIBRARY_MAGIC_STRING), gc))\n {\n fprintf(stderr,\n \"%s: bad version string, is this a PZ file?\\n\",\n bytecode_filename.c_str());\n return false;\n }\n }\n\n if (!read.file.read_uint16(&version)) return false;\n if (version != PZ_FORMAT_VERSION) {\n fprintf(stderr,\n \"Incorrect PZ version, found %d, expecting %d\\n\",\n version,\n PZ_FORMAT_VERSION);\n return false;\n }\n\n Optional entry_closure;\n if (!read_options(read.file, entry_closure)) return false;\n\n Root foreign(gc);\n if (native_filename.hasValue()) {\n if (!Foreign::maybe_load(native_filename.value(), gc, foreign) ||\n !foreign->init(gc))\n {\n fprintf(stderr, \"Couldn't initialise foreign code\\n\");\n return false;\n }\n }\n\n uint32_t num_names;\n if (!read.file.read_uint32(&num_names)) return false;\n for (unsigned i = 0; i < num_names; i++) {\n Optional maybe_name = read.file.read_len_string(gc);\n if (!maybe_name.hasValue()) return false;\n if (names) {\n RootString name(gc, maybe_name.release());\n names->append(gc, name);\n }\n }\n\n if (!read.file.read_uint32(&num_imports)) return false;\n if (!read.file.read_uint32(&num_structs)) return false;\n if (!read.file.read_uint32(&num_datas)) return false;\n if (!read.file.read_uint32(&num_procs)) return false;\n if (!read.file.read_uint32(&num_closures)) return false;\n if (!read.file.read_uint32(&num_exports)) return false;\n\n Root lib_load(gc);\n {\n NoGCScope no_gc(gc);\n lib_load = new(no_gc) LibraryLoading(num_structs,\n num_datas,\n num_procs,\n num_closures,\n no_gc);\n no_gc.abort_if_oom(\"loading a module\");\n }\n\n Root imported(gc, new (gc) Imported(num_imports));\n\n if (!read_imports(read, num_imports, imported.ptr(), foreign.ptr(), gc)) {\n return false;\n }\n\n if (!read_structs(read, num_structs, lib_load.ptr(), gc)) return false;\n\n /*\n * read the file in two passes. During the first pass we calculate the\n * sizes of datas and procedures and therefore calculating the addresses\n * where each individual entry begins. Then in the second pass we fill\n * read the bytecode and data, resolving any intra-module references.\n */\n if (!read_data(read, num_datas, lib_load.ptr(), imported.ptr(), gc)) {\n return false;\n }\n if (!read_code(read, num_procs, lib_load.ptr(), imported.ptr(), gc)) {\n return false;\n }\n\n if (!read_closures(read, num_closures, imported.ptr(), lib_load.ptr())) {\n return false;\n }\n\n if (!read_exports(read, num_exports, lib_load.ptr(), gc)) {\n return false;\n }\n\n#ifdef PZ_DEV\n /*\n * We should now be at the end of the file, so we should expect to get\n * an error if we read any further.\n */\n uint8_t extra_byte;\n if (read.file.read_uint8(&extra_byte)) {\n fprintf(stderr, \"%s: junk at end of file\\n\", bytecode_filename.c_str());\n return false;\n }\n if (!read.file.is_at_eof()) {\n fprintf(stderr, \"%s: junk at end of file\\n\", bytecode_filename.c_str());\n return false;\n }\n#endif\n read.file.close();\n\n library = new (gc) Library(lib_load.get());\n if (entry_closure.hasValue()) {\n library->set_entry_closure(entry_closure.value().signature,\n lib_load->closure(entry_closure.value().closure_id));\n }\n\n return true;\n}\n\nstatic bool read_options(BinaryInput & file, Optional & mbEntry)\n{\n uint16_t num_options;\n\n if (!file.read_uint16(&num_options)) return false;\n\n for (unsigned i = 0; i < num_options; i++) {\n uint16_t type, len;\n\n if (!file.read_uint16(&type)) return false;\n if (!file.read_uint16(&len)) return false;\n\n switch (type) {\n case PZ_OPT_ENTRY_CLOSURE: {\n uint8_t entry_signature_uint;\n uint32_t entry_closure;\n if (len != 5) {\n fprintf(stderr,\n \"%s: Corrupt file while reading options\",\n file.filename_c());\n return false;\n }\n if (!file.read_uint8(&entry_signature_uint)) return false;\n if (!file.read_uint32(&entry_closure)) return false;\n\n PZOptEntrySignature entry_signature =\n static_cast(entry_signature_uint);\n mbEntry.set(EntryClosure(entry_signature, entry_closure));\n break;\n }\n default:\n if (!file.seek_cur(len)) return false;\n break;\n }\n }\n\n return true;\n}\n\nstatic bool read_imports(ReadInfo & read, unsigned num_imports,\n Imported * imported,\n const Foreign * foreign,\n GCTracer &gc)\n{\n for (uint32_t i = 0; i < num_imports; i++) {\n uint8_t type_;\n if (!read.file.read_uint8(&type_)) return false;\n if (type_ > PZ_IMPORT_LAST) return false;\n PZ_Import_Type type = static_cast(type_);\n\n Optional maybe_module_name = read.file.read_len_string(gc);\n if (!maybe_module_name.hasValue()) return false;\n RootString module_name(gc, maybe_module_name.release());\n Optional maybe_name = read.file.read_len_string(gc);\n if (!maybe_name.hasValue()) return false;\n RootString name(gc, maybe_name.release());\n\n switch (type) {\n case PZ_IMPORT_IMPORT: {\n Library * library = read.pz.lookup_library(module_name);\n if (!library) {\n fprintf(stderr, \"Module not found: %s\\n\", module_name.c_str());\n return false;\n }\n\n RootString module_dot(gc,\n String::append(gc, module_name, String(\".\")));\n RootString lookup_name(gc, String::append(gc, module_dot, name));\n Optional maybe_export =\n library->lookup_symbol(lookup_name);\n\n if (maybe_export.hasValue()) {\n imported->import_closures.push_back(maybe_export.value());\n } else {\n fprintf(stderr,\n \"Procedure not found: %s\\n\",\n lookup_name.c_str());\n return false;\n }\n break;\n }\n case PZ_IMPORT_FOREIGN: {\n if (!foreign) {\n fprintf(stderr,\n \"No foreign code provided for %s\\n\",\n module_name.c_str());\n return false;\n }\n Closure *closure = foreign->lookup_foreign_proc(module_name, name);\n if (!closure) {\n fprintf(stderr,\n \"Foreign procedure not found: %s.%s\\n\",\n module_name.c_str(), name.c_str());\n return false;\n }\n imported->import_closures.push_back(closure);\n break;\n }\n }\n }\n\n return true;\n}\n\nstatic bool\nread_structs(ReadInfo &read,\n unsigned num_structs,\n LibraryLoading *library,\n GCCapability &gc)\n{\n for (unsigned i = 0; i < num_structs; i++) {\n uint32_t num_fields;\n\n if (!read.file.read_uint32(&num_fields)) return false;\n\n Struct * s = library->new_struct(num_fields, gc);\n\n for (unsigned j = 0; j < num_fields; j++) {\n Optional mb_width = read_data_width(read.file);\n if (mb_width.hasValue()) {\n s->set_field(j, mb_width.value());\n } else {\n return false;\n }\n }\n\n s->calculate_layout();\n }\n\n return true;\n}\n\nstatic bool\nread_data(ReadInfo &read,\n unsigned num_datas,\n LibraryLoading *library,\n Imported *imports,\n GCCapability &gc)\n{\n unsigned total_size = 0;\n void * data = nullptr;\n\n for (uint32_t i = 0; i < num_datas; i++) {\n uint8_t data_type_id;\n\n if (!read.file.read_uint8(&data_type_id)) return false;\n switch (data_type_id) {\n case PZ_DATA_ARRAY: {\n uint16_t num_elements;\n if (!read.file.read_uint16(&num_elements)) return false;\n\n Optional maybe_width = read_data_width(read.file);\n if (!maybe_width.hasValue()) return false;\n PZ_Width width = maybe_width.value();\n data = data_new_array_data(gc, width, num_elements);\n uint8_t *data_ptr = (uint8_t *)data;\n\n uint8_t raw_enc;\n if (!read.file.read_uint8(&raw_enc)) return false;\n enum pz_data_enc_type type = PZ_DATA_ENC_TYPE(raw_enc);\n uint8_t enc_width = PZ_DATA_ENC_BYTES(raw_enc);\n for (unsigned i = 0; i < num_elements; i++) {\n if (!read_data_slot(read, type, enc_width, data_ptr,\n library, imports))\n {\n return false;\n }\n data_ptr += width_to_bytes(width);\n }\n total_size += width_to_bytes(width) * num_elements;\n break;\n }\n case PZ_DATA_STRUCT: {\n uint32_t struct_id;\n if (!read.file.read_uint32(&struct_id)) return false;\n const Struct * struct_ = library->struct_(struct_id);\n\n data = data_new_struct_data(gc, struct_->total_size());\n for (unsigned f = 0; f < struct_->num_fields(); f++) {\n uint8_t raw_enc;\n if (!read.file.read_uint8(&raw_enc)) return false;\n enum pz_data_enc_type type = PZ_DATA_ENC_TYPE(raw_enc);\n uint8_t enc_width = PZ_DATA_ENC_BYTES(raw_enc);\n void * dest = reinterpret_cast(data) +\n struct_->field_offset(f);\n if (!read_data_slot(read, type, enc_width, dest,\n library, imports)) {\n return false;\n }\n }\n break;\n }\n case PZ_DATA_STRING: {\n uint16_t num_elements;\n if (!read.file.read_uint16(&num_elements)) return false;\n\n uint8_t raw_enc;\n if (!read.file.read_uint8(&raw_enc)) return false;\n enum pz_data_enc_type type = PZ_DATA_ENC_TYPE(raw_enc);\n uint8_t enc_width = PZ_DATA_ENC_BYTES(raw_enc);\n\n // TODO: We can check if the string is empty using\n // num_elements, but we can't perform a shortcut to use the\n // canonical empty string since that is the null pointer.\n // But PZ file reading assumes that other data items wont be\n // null (it thinks they're not filled in yet) (#392).\n\n // TODO: utf8\n FlatString *s = FlatString::New(gc, num_elements);\n data = String(s).ptr();\n uint8_t * data_ptr = reinterpret_cast(s->buffer());\n\n for (unsigned i = 0; i < num_elements; i++) {\n if (!read_data_slot(read, type, enc_width, data_ptr,\n library, imports))\n {\n return false;\n }\n data_ptr++;\n }\n\n total_size += s->storageSize();\n break;\n }\n }\n\n library->add_data(data);\n data = nullptr;\n }\n\n if (read.verbose) {\n printf(\"Loaded %d data entries with a total of %d bytes\\n\",\n (unsigned)num_datas,\n total_size);\n }\n\n return true;\n}\n\nstatic Optional read_data_width(BinaryInput & file)\n{\n uint8_t raw_width;\n if (!file.read_uint8(&raw_width)) return Optional::Nothing();\n return width_from_int(raw_width);\n}\n\nstatic bool\nread_data_slot(ReadInfo &read,\n enum pz_data_enc_type type,\n uint8_t enc_width,\n void *dest,\n LibraryLoading *library,\n Imported *imports)\n{\n switch (type) {\n case pz_data_enc_type_normal:\n switch (enc_width) {\n case 1: {\n uint8_t value;\n if (!read.file.read_uint8(&value)) return false;\n data_write_normal_uint8(dest, value);\n return true;\n }\n case 2: {\n uint16_t value;\n if (!read.file.read_uint16(&value)) return false;\n data_write_normal_uint16(dest, value);\n return true;\n }\n case 4: {\n uint32_t value;\n if (!read.file.read_uint32(&value)) return false;\n data_write_normal_uint32(dest, value);\n return true;\n }\n case 8: {\n uint64_t value;\n if (!read.file.read_uint64(&value)) return false;\n data_write_normal_uint64(dest, value);\n return true;\n }\n default:\n fprintf(stderr, \"Unexpected data encoding %d.\\n\",\n (int)type);\n return false;\n }\n case pz_data_enc_type_fast: {\n uint32_t i32;\n\n /*\n * For these width types the encoded width is 32bit.\n */\n if (!read.file.read_uint32(&i32)) return false;\n data_write_fast_from_int32(dest, i32);\n return true;\n }\n case pz_data_enc_type_wptr: {\n int32_t i32;\n\n /*\n * For these width types the encoded width is 32bit.\n */\n if (!read.file.read_uint32((uint32_t *)&i32)) return false;\n data_write_wptr(dest, (uintptr_t)i32);\n return true;\n }\n case pz_data_enc_type_data: {\n uint32_t ref;\n void ** dest_ = (void **)dest;\n void * data;\n\n // Data is a reference, link in the correct information.\n // XXX: support non-data references, such as proc\n // references.\n if (!read.file.read_uint32(&ref)) return false;\n data = library->data(ref);\n if (data != nullptr) {\n *dest_ = data;\n } else {\n fprintf(stderr, \"forward references arn't yet supported.\\n\");\n abort();\n }\n return true;\n }\n case pz_data_enc_type_import: {\n uint32_t ref;\n void ** dest_ = (void **)dest;\n Closure * import;\n\n // Data is a reference, link in the correct information.\n // XXX: support non-data references, such as proc\n // references.\n if (!read.file.read_uint32(&ref)) return false;\n assert(ref < imports->num_imports());\n import = imports->import_closures[ref];\n assert(import);\n *dest_ = import;\n return true;\n }\n case pz_data_enc_type_closure: {\n uint32_t ref;\n void ** dest_ = (void **)dest;\n\n if (!read.file.read_uint32(&ref)) return false;\n Closure * closure = library->closure(ref);\n assert(closure);\n *dest_ = closure;\n return true;\n }\n default:\n // GCC is having trouble recognising this complete switch.\n fprintf(stderr, \"Unrecognised data item encoding.\\n\");\n abort();\n }\n}\n\nstatic bool\nread_code(ReadInfo &read,\n unsigned num_procs,\n LibraryLoading *library,\n Imported *imported,\n GCCapability &gc)\n{\n unsigned * block_offsets[num_procs];\n memset(block_offsets, 0, sizeof(unsigned *) * num_procs);\n ScopeExit cleanup([&block_offsets, num_procs] {\n for (unsigned i = 0; i < num_procs; i++) {\n delete[] block_offsets[i];\n }\n });\n\n /*\n * We read procedures in two phases, once to calculate their sizes, and\n * label offsets, allocating memory for each one. Then the we read them\n * for real in the second phase when memory locations are known.\n */\n if (read.verbose) {\n fprintf(stderr, \"Reading procs first pass\\n\");\n }\n auto file_pos = read.file.tell();\n if (!file_pos.hasValue()) return false;\n\n for (unsigned i = 0; i < num_procs; i++) {\n unsigned proc_size;\n\n if (read.verbose) {\n fprintf(stderr, \"Reading proc %d\\n\", i);\n }\n\n Optional name = read.file.read_len_string(gc);\n if (!name.hasValue()) return false;\n\n proc_size =\n read_proc(read, imported, library, nullptr, &block_offsets[i], gc);\n if (proc_size == 0) return false;\n library->new_proc(name.value(), proc_size, false, gc);\n }\n\n /*\n * Now that we've allocated memory for all the procedures, re-read them\n * this time writing them into that memory. We do this for all the\n * procedures at once otherwise calls in earlier procedures would not\n * know the code addresses of later procedures.\n */\n if (read.verbose) {\n fprintf(stderr, \"Beginning second pass\\n\");\n }\n if (!read.file.seek_set(file_pos.value())) return false;\n for (unsigned i = 0; i < num_procs; i++) {\n if (read.verbose) {\n fprintf(stderr, \"Reading proc %d\\n\", i);\n }\n\n // Read but don't use the name, it's already set.\n Optional name = read.file.read_len_string(gc);\n if (!name.hasValue()) return false;\n\n if (0 == read_proc(read, imported, library, library->proc(i),\n &block_offsets[i], gc))\n {\n return false;\n }\n }\n\n if (read.verbose) {\n library->print_loaded_stats();\n }\n\n return true;\n}\n\nstatic unsigned\nread_proc(ReadInfo &read,\n Imported *imported,\n LibraryLoading *library,\n Proc *proc,\n unsigned **block_offsets,\n GCCapability &gc)\n{\n uint32_t num_blocks;\n bool first_pass = (proc == nullptr);\n unsigned proc_offset = 0;\n BinaryInput & file = read.file;\n\n /*\n * XXX: Signatures currently aren't written into the bytecode, but\n * here's where they might appear.\n */\n\n if (!file.read_uint32(&num_blocks)) return 0;\n if (first_pass) {\n /*\n * This is the first pass - set up the block offsets array.\n */\n *block_offsets = new unsigned[num_blocks];\n }\n\n for (unsigned i = 0; i < num_blocks; i++) {\n uint32_t num_instructions;\n\n if (first_pass) {\n /*\n * Fill in the block_offsets array\n */\n (*block_offsets)[i] = proc_offset;\n }\n\n if (!file.read_uint32(&num_instructions)) return 0;\n for (uint32_t j = 0; j < num_instructions; j++) {\n uint8_t byte;\n if (!file.read_uint8(&byte)) return false;\n\n if (PZ_CODE_INSTR == byte) {\n if (!read_instr(file,\n imported,\n library,\n proc ? proc->code() : nullptr,\n block_offsets,\n proc_offset))\n {\n return 0;\n }\n } else {\n if (!read_meta(read, library, proc, proc_offset, byte, gc)) {\n return 0;\n }\n }\n }\n }\n\n return proc_offset;\n}\n\nstatic bool\nread_instr(BinaryInput &file, Imported *imported, LibraryLoading *library,\n uint8_t *proc_code, unsigned **block_offsets, unsigned &proc_offset)\n{\n uint8_t byte;\n PZ_Opcode opcode;\n Optional width1, width2;\n ImmediateType immediate_type;\n ImmediateValue immediate_value;\n bool first_pass = (proc_code == nullptr);\n\n /*\n * Read the opcode and the data width(s)\n */\n if (!file.read_uint8(&byte)) return false;\n opcode = static_cast(byte);\n if (instruction_info[opcode].ii_num_width_bytes > 0) {\n width1 = read_data_width(file);\n if (instruction_info[opcode].ii_num_width_bytes > 1) {\n width2 = read_data_width(file);\n }\n }\n\n /*\n * Read any immediate value\n */\n immediate_type = instruction_info[opcode].ii_immediate_type;\n switch (immediate_type) {\n case IMT_NONE:\n memset(&immediate_value, 0, sizeof(ImmediateValue));\n break;\n case IMT_8:\n if (!file.read_uint8(&immediate_value.uint8)) return false;\n break;\n case IMT_16:\n if (!file.read_uint16(&immediate_value.uint16)) return false;\n break;\n case IMT_32:\n if (!file.read_uint32(&immediate_value.uint32)) return false;\n break;\n case IMT_64:\n if (!file.read_uint64(&immediate_value.uint64)) return false;\n break;\n case IMT_CLOSURE_REF: {\n uint32_t closure_id;\n if (!file.read_uint32(&closure_id)) return false;\n if (!first_pass) {\n immediate_value.word = (uintptr_t)library->closure(closure_id);\n } else {\n immediate_value.word = 0;\n }\n break;\n }\n case IMT_PROC_REF: {\n uint32_t proc_id;\n if (!file.read_uint32(&proc_id)) return false;\n if (!first_pass) {\n immediate_value.word = (uintptr_t)library->proc(proc_id)->code();\n } else {\n immediate_value.word = 0;\n }\n break;\n }\n case IMT_IMPORT_CLOSURE_REF: {\n uint32_t import_id;\n if (!file.read_uint32(&import_id)) return false;\n immediate_value.word =\n (uintptr_t)imported->import_closures.at(import_id);\n break;\n }\n case IMT_LABEL_REF: {\n uint32_t imm32;\n if (!file.read_uint32(&imm32)) return false;\n if (!first_pass) {\n immediate_value.word =\n (uintptr_t)&proc_code[(*block_offsets)[imm32]];\n } else {\n immediate_value.word = 0;\n }\n break;\n }\n case IMT_STRUCT_REF: {\n uint32_t imm32;\n if (!file.read_uint32(&imm32)) return false;\n immediate_value.word = library->struct_(imm32)->total_size();\n break;\n }\n case IMT_STRUCT_REF_FIELD: {\n uint32_t imm32;\n uint8_t imm8;\n\n if (!file.read_uint32(&imm32)) return false;\n if (!file.read_uint8(&imm8)) return false;\n immediate_value.uint16 = library->struct_(imm32)->field_offset(imm8);\n break;\n }\n }\n\n if (width1.hasValue()) {\n if (width2.hasValue()) {\n assert(immediate_type == IMT_NONE);\n proc_offset = write_instr(\n proc_code, proc_offset, opcode, width1.value(), width2.value());\n } else {\n if (immediate_type == IMT_NONE) {\n proc_offset =\n write_instr(proc_code, proc_offset, opcode, width1.value());\n } else {\n proc_offset = write_instr(proc_code,\n proc_offset,\n opcode,\n width1.value(),\n immediate_type,\n immediate_value);\n }\n }\n } else {\n if (immediate_type == IMT_NONE) {\n proc_offset = write_instr(proc_code, proc_offset, opcode);\n } else {\n proc_offset = write_instr(proc_code,\n proc_offset,\n opcode,\n immediate_type,\n immediate_value);\n }\n }\n\n return true;\n}\n\nstatic bool read_meta(ReadInfo & read, LibraryLoading * library, Proc * proc,\n unsigned proc_offset, uint8_t meta_byte,\n GCCapability & gc)\n{\n BinaryInput & file = read.file;\n uint32_t data_id;\n uint32_t line_no;\n\n switch (meta_byte) {\n case PZ_CODE_META_CONTEXT: {\n // We only need to read the context info when enabled\n // and during the second pass.\n if (proc && read.load_debuginfo) {\n if (!file.read_uint32(&data_id)) return false;\n String filename = String::from_ptr(library->data(data_id));\n if (!file.read_uint32(&line_no)) return false;\n\n proc->add_context(gc, proc_offset, filename, line_no);\n } else {\n file.seek_cur(8);\n }\n break;\n }\n case PZ_CODE_META_CONTEXT_SHORT: {\n if (proc && read.load_debuginfo) {\n if (!file.read_uint32(&line_no)) return false;\n proc->add_context(gc, proc_offset, line_no);\n } else {\n file.seek_cur(4);\n }\n break;\n }\n case PZ_CODE_META_CONTEXT_NIL:\n if (proc && read.load_debuginfo) {\n proc->no_context(gc, proc_offset);\n }\n break;\n default:\n fprintf(stderr, \"Unknown byte in instruction stream\");\n abort();\n }\n\n return true;\n}\n\nstatic bool\nread_closures(ReadInfo &read,\n unsigned num_closures,\n Imported *imported,\n LibraryLoading *library)\n{\n for (unsigned i = 0; i < num_closures; i++) {\n uint32_t proc_id;\n uint32_t data_id;\n uint8_t * proc_code;\n void * data;\n\n if (!read.file.read_uint32(&proc_id)) return false;\n proc_code = library->proc(proc_id)->code();\n\n if (!read.file.read_uint32(&data_id)) return false;\n data = library->data(data_id);\n\n library->closure(i)->init(proc_code, data);\n }\n\n return true;\n}\n\nstatic bool\nread_exports(ReadInfo &read,\n unsigned num_exports,\n LibraryLoading *library,\n GCTracer &gc)\n{\n for (unsigned i = 0; i < num_exports; i++) {\n Optional mb_name = read.file.read_len_string(gc);\n if (!mb_name.hasValue()) {\n return false;\n }\n RootString name(gc, mb_name.release());\n\n uint32_t clo_id;\n if (!read.file.read_uint32(&clo_id)) {\n return false;\n }\n\n Closure * closure = library->closure(clo_id);\n if (!closure) {\n fprintf(stderr, \"Closure ID unknown\");\n return false;\n }\n\n library->add_symbol(name, closure);\n }\n\n return true;\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_read.h", "content": "/*\n * Plasma bytecode reader\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_READ_H\n#define PZ_READ_H\n\nnamespace pz {\n\n/*\n * Read a bytecode library from the given file. it may reference symbols in\n * pz. library and names are out-parameters, names is ignored if it's null.\n */\nbool read(PZ & pz, const std::string & bytecode_filename,\n const Optional & native_filename,\n Root & library, Vector * names, GCTracer & gc);\n\n} // namespace pz\n\n#endif /* ! PZ_READ_H */\n" }, { "path": "runtime/pz_string.cpp", "content": "/*\n * Plasma strings\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \n\n#include \"pz_common.h\"\n#include \"pz_gc.h\"\n\n#include \"pz_string.h\"\n\nnamespace pz {\n\nstatic void\nAssertAligned(const void *p) {\n assert((reinterpret_cast(p) & HIGH_TAG_MASK) == 0);\n}\n\nString::String() :\n mType(ST_EMPTY)\n{\n s.cStr = nullptr;\n}\n\nString::String(const BaseString * base_str) :\n mType(ST_FLAT)\n{\n // Pointers must be aligned\n AssertAligned(base_str);\n s.baseStr = base_str;\n}\n\nString::String(const char *c_str) :\n mType(ST_CONST)\n{\n // Pointers must be aligned\n AssertAligned(c_str);\n s.cStr = c_str;\n}\n\nvoid *\nString::ptr() const {\n if (mType == ST_EMPTY) {\n return nullptr;\n } else {\n return reinterpret_cast(\n reinterpret_cast(s.cStr) | \n (static_cast(mType) << HIGH_TAG_SHIFT));\n }\n}\n\nString\nString::from_ptr(void *ptr) {\n if (ptr == nullptr) {\n return String();\n } else {\n StringType tag = static_cast(\n (reinterpret_cast(ptr) & HIGH_TAG_MASK) >> HIGH_TAG_SHIFT);\n uintptr_t pointer_no_tag =\n reinterpret_cast(ptr) & ~HIGH_TAG_MASK;\n\n switch (tag) {\n case ST_FLAT:\n return String(reinterpret_cast(pointer_no_tag));\n case ST_CONST:\n return String(reinterpret_cast(pointer_no_tag));\n default:\n abort();\n }\n }\n}\n\nvoid\nString::print() const {\n switch (mType) {\n case ST_CONST:\n printf(\"%s\", s.cStr);\n break;\n case ST_FLAT:\n s.baseStr->print();\n break;\n case ST_EMPTY:\n break;\n }\n}\n\nuint32_t\nString::length() const {\n switch (mType) {\n case ST_CONST:\n return strlen(s.cStr);\n case ST_FLAT:\n return s.baseStr->length();\n case ST_EMPTY:\n return 0;\n default:\n abort();\n }\n}\n\nbool\nString::isEmpty() const {\n switch (mType) {\n case ST_CONST:\n return s.cStr[0] == '\\0';\n case ST_FLAT:\n return s.baseStr->isEmpty();\n case ST_EMPTY:\n return true;\n default:\n abort();\n }\n}\n\nbool\nString::equals(const String &other) const {\n return equals_pointer(other) || (0 == strcmp(c_str(), other.c_str()));\n}\n\nbool\nString::equals_pointer(const String &other) const {\n return this->s.cStr == other.s.cStr;\n}\n\nbool\nString::startsWith(const String & other, GCCapability &gc0) const {\n if (other.length() > length())\n return false;\n\n GCTracer gc(gc0);\n Root thispos(gc, begin(gc));\n Root otherpos(gc, other.begin(gc));\n while (!otherpos->at_end()) {\n assert(!thispos->at_end());\n\n if (thispos->next_char() != otherpos->next_char()) {\n return false;\n }\n\n thispos = thispos->forward(gc);\n otherpos = otherpos->forward(gc);\n }\n\n return true;\n}\n\nconst char *\nString::c_str() const {\n switch (mType) {\n case ST_CONST:\n return s.cStr;\n case ST_FLAT:\n return s.baseStr->c_str();\n case ST_EMPTY:\n return \"\";\n default:\n abort();\n }\n}\n\nCodePoint32\nString::char_at(unsigned i) const {\n assert(i < length());\n // XXX make better.\n return c_str()[i];\n}\n\nsize_t\nString::hash() const {\n const char *c = c_str();\n size_t hash = 0;\n\n for (unsigned i = 0; i < length(); i++) {\n hash = (hash >> (sizeof(size_t)*8-1) | hash << 1) ^\n std::hash{}(c[i]);\n }\n\n return hash;\n}\n\nString\nString::append(GCCapability &gc, const String s1, const String s2) {\n uint32_t len = s1.length() + s2.length();\n if (len == 0) {\n return String();\n } else {\n FlatString *s = FlatString::New(gc, len);\n strcpy(s->buffer(), s1.c_str());\n strcat(s->buffer(), s2.c_str());\n return String(s);\n }\n}\n \nString\nString::substring(GCCapability &gc, const StringPos * pos1,\n const StringPos * pos2)\n{\n assert(pos1->mPos <= pos1->mStr.length());\n assert(pos2->mPos <= pos2->mStr.length());\n\n if (!pos1->mStr.equals_pointer(pos2->mStr)) {\n fprintf(stderr, \"Substring for two different strings\\n\");\n exit(1);\n }\n\n // This uses negative numbers to check when the beginning is after the\n // end.\n int len = pos2->mPos - pos1->mPos;\n if (len <= 0) {\n return String();\n }\n\n FlatString *s = FlatString::New(gc, len);\n strncpy(s->buffer(), &pos1->mStr.c_str()[pos1->mPos], len);\n return String(s);\n}\n\nString\nString::dup(GCCapability &gc, const std::string & str)\n{\n uint32_t len = str.length();\n if (len == 0) {\n return String();\n } else {\n FlatString *s = FlatString::New(gc, len);\n strcpy(s->buffer(), str.c_str());\n return String(s);\n }\n}\n\nbool\nString::operator==(const String other) const\n{\n return equals(other);\n}\n\nStringPos*\nString::begin(GCCapability &gc) const {\n return new(gc) StringPos(*this, 0);\n}\n\nStringPos*\nString::end(GCCapability &gc) const {\n // XXX won't work with other encodings.\n return new(gc) StringPos(*this, length());\n}\n\n/*\n * FlatString\n *************/\n\nFlatString::FlatString(uint32_t len) :\n mLen(len)\n{\n#ifdef DEBUG\n // Make debugging slightly more predictable.\n memset(mBuffer, 'X', len);\n#endif\n mBuffer[len] = 0;\n}\n\nFlatString*\nFlatString::New(GCCapability &gc, uint32_t len) {\n void *mem = gc.alloc_bytes(sizeof(FlatString) + len + 1);\n return new(mem) FlatString(len);\n}\n\nStringType\nFlatString::type() const{\n return ST_FLAT;\n}\n\nvoid\nFlatString::print() const {\n printf(\"%s\", mBuffer);\n}\n\nuint32_t\nFlatString::length() const {\n return mLen;\n}\n\nbool\nFlatString::isEmpty() const {\n return mLen == 0;\n}\n\nuint32_t\nFlatString::storageSize() const {\n return sizeof(FlatString) + mLen + 1;\n}\n\nconst char *\nFlatString::c_str() const {\n return reinterpret_cast(mBuffer);\n}\n\nvoid\nFlatString::fixSize(uint32_t len) {\n assert(len <= mLen);\n mBuffer[len] = 0;\n mLen = len;\n}\n\n/*\n * StringPos \n ************/\n\nbool\nStringPos::at_beginning() const {\n return mPos == 0;\n}\n\nbool\nStringPos::at_end() const {\n return mPos == mStr.length();\n}\n\nStringPos *\nStringPos::forward(GCCapability &gc) const {\n if (at_end()) {\n fprintf(stderr, \"StringPos already at end\\n\");\n exit(1);\n }\n return new(gc) StringPos(mStr, mPos+1);\n}\n\nStringPos *\nStringPos::backward(GCCapability &gc) const {\n if (at_beginning()) {\n fprintf(stderr, \"StringPos already at beginning\");\n exit(1);\n }\n return new(gc) StringPos(mStr, mPos-1);\n}\n\nCodePoint32\nStringPos::next_char() const {\n if (mPos == mStr.length()) {\n fprintf(stderr, \"Access next character at end of string\\n\");\n exit(1);\n }\n return mStr.char_at(mPos);\n}\n\nCodePoint32\nStringPos::prev_char() const {\n if (mPos == 0) {\n fprintf(stderr, \"Access previous character at beginning of string\\n\");\n exit(1);\n }\n return mStr.char_at(mPos - 1);\n}\n\n} // namespace pz\n\nnamespace std\n{\n size_t\n hash::operator()(pz::String const& s) const noexcept\n {\n return s.hash();\n }\n}\n\n" }, { "path": "runtime/pz_string.h", "content": "/*\n * Plasma strings\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_STRING_H\n#define PZ_STRING_H\n\n#include \"pz_gc_util.h\"\n\n#include \n\nnamespace pz {\n\ntypedef uint32_t CodePoint32;\n\nclass BaseString;\nclass StringPos;\n\nenum StringType : uint8_t {\n ST_FLAT = 0,\n ST_CONST,\n ST_EMPTY\n};\n\n/*\n * Ths string class wraps a reference to the real string. You should pass it\n * by value rather than pointer or reference.\n */\nclass String {\n private:\n union {\n const BaseString *baseStr;\n const char *cStr;\n } s;\n StringType mType;\n\n public:\n String();\n explicit String(const BaseString *);\n explicit String(const char *);\n\n // Get a raw pointer (for the bytecode interpreter).\n void* ptr() const;\n static\n String from_ptr(void*);\n\n protected:\n // GC ptr-ptr. Get a pointer to the pointer, for GC rooting.\n const void ** gc_ptr() {\n switch (mType) {\n case ST_EMPTY:\n case ST_CONST:\n return nullptr;\n case ST_FLAT:\n return reinterpret_cast(&s.baseStr);\n default:\n fprintf(stderr, \"Invalid string type\");\n abort();\n }\n };\n\n public:\n void print() const;\n bool equals(const String &) const;\n bool equals_pointer(const String &) const;\n bool startsWith(const String &, GCCapability &gc) const;\n\n // Length in code points\n uint32_t length() const;\n bool isEmpty() const;\n\n // Length in bytes in RAM, including bookkeeping.\n uint32_t storageSize() const;\n\n const char * c_str() const;\n\n // Get the character at this raw position.\n CodePoint32 char_at(unsigned i) const;\n\n size_t hash() const;\n\n static\n String append(GCCapability &gc, const String, const String);\n\n static\n String substring(GCCapability &gc, const StringPos * pos1,\n const StringPos * pos2);\n\n static\n String dup(GCCapability &gc, const std::string &str);\n\n bool operator==(const String string) const;\n\n StringPos* begin(GCCapability &gc) const;\n StringPos* end(GCCapability &gc) const;\n};\n\nclass RootString : public String {\n private:\n GCTracer & m_tracer;\n\n public:\n RootString(GCTracer & gc, String && str) : String(str), m_tracer(gc) {\n m_tracer.add_root(gc_ptr());\n }\n ~RootString() {\n m_tracer.remove_root(gc_ptr());\n }\n};\n\nclass BaseString {\n public:\n virtual StringType type() const = 0;\n\n virtual void print() const = 0;\n\n // Length in code points\n virtual uint32_t length() const = 0;\n virtual bool isEmpty() const = 0;\n\n // Length in bytes in RAM, including bookkeeping.\n virtual uint32_t storageSize() const = 0;\n\n virtual const char * c_str() const = 0;\n};\n\n// A flat string has both a null-terminating byte and a length field.\nclass FlatString : public BaseString {\n private:\n uint32_t mLen;\n uint8_t mBuffer[];\n\n protected:\n FlatString(uint32_t len);\n\n public:\n // We don't use the GCNew class' placement new because we need custom\n // lengths.\n static FlatString* New(GCCapability &gc, uint32_t len);\n\n StringType type() const override;\n\n void print() const override;\n uint32_t length() const override;\n bool isEmpty() const override;\n uint32_t storageSize() const override;\n\n const char * c_str() const override;\n\n char * buffer() {\n return reinterpret_cast(mBuffer);\n }\n const char * buffer() const {\n return reinterpret_cast(mBuffer);\n }\n\n void fixSize(uint32_t len);\n};\n\nclass StringPos : public GCNew {\n const String mStr;\n unsigned mPos;\n\n public:\n StringPos(const String &str, unsigned pos) :\n mStr(str), mPos(pos) {}\n\n bool at_beginning() const;\n bool at_end() const;\n\n StringPos* forward(GCCapability &gc) const;\n StringPos* backward(GCCapability &gc) const;\n\n CodePoint32 next_char() const;\n CodePoint32 prev_char() const;\n\n friend class String;\n};\n\n} // namespace pz\n\nnamespace std\n{\n template<> struct hash\n {\n size_t operator()(pz::String const& s) const noexcept;\n };\n}\n\n#endif // ! PZ_String_H\n" }, { "path": "runtime/pz_trace.cpp", "content": "/*\n * Plasma execution tracing.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#include \n\n#include \"pz_common.h\"\n\n#include \"pz_code.h\"\n#include \"pz_gc.h\"\n#include \"pz_trace.h\"\n#include \"pz_string.h\"\n#include \"pz_util.h\"\n\nnamespace pz {\n\nbool trace_enabled = false;\n\n/*\n * THese are used to cache some lookup information to find line numbers\n * within procs.\n */\nProc * last_proc = nullptr;\nunsigned last_lookup = 0;\n\nvoid trace_instr_(unsigned rsp, const char * instr_name)\n{\n fprintf(stderr, \"%4u: %s\\n\", rsp, instr_name);\n}\n\nvoid trace_instr2_(unsigned rsp, const char * instr_name, int num)\n{\n fprintf(stderr, \"%4u: %s %d\\n\", rsp, instr_name, num);\n}\n\nvoid trace_state_(const Heap * heap, void * ip, void * env,\n unsigned rsp, unsigned esp, uint64_t * stack)\n{\n void * code = heap_interior_ptr_to_ptr(heap, ip);\n assert(ip >= code);\n std::ptrdiff_t offset =\n reinterpret_cast(ip) - reinterpret_cast(code);\n\n // XXX These should be GC roots.\n Proc * proc = reinterpret_cast(heap_meta_info(heap, code));\n\n if (proc) {\n fprintf(stderr, \" IP %p: %s+%ld%s\", ip,\n proc->name().c_str(),\n (long)offset,\n proc->is_builtin() ? \" (builtin)\" : \"\");\n } else {\n fprintf(stderr, \" IP %p: +%ld (builtin)\", ip,\n (long)offset);\n }\n\n unsigned line = 0;\n if (proc && proc->filename().hasValue()) {\n if (proc != last_proc) {\n last_lookup = 0;\n last_proc = proc;\n }\n line = proc->line(offset, &last_lookup);\n if (line) {\n fprintf(stderr, \" from %s:%d\", proc->filename().value().c_str(),\n line);\n }\n }\n\n fprintf(stderr, \"\\n\");\n\n fprintf(stderr, \" ENV %p\\n\", env);\n fprintf(stderr, \" RSP %4u ESP %4u\\n\", rsp, esp);\n fprintf(stderr, \" stack: \");\n\n int start = esp - 4;\n start = start >= 1 ? start : 1;\n\n for (unsigned i = start; i <= esp; i++) {\n fprintf(stderr, \"0x%.\" WORDSIZE_HEX_CHARS_STR PRIx64 \" \", stack[i]);\n }\n fprintf(stderr, \"\\n\\n\");\n}\n\n} // namespace pz\n" }, { "path": "runtime/pz_trace.h", "content": "/*\n * Plasma execution tracing.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_TRACE_H\n#define PZ_TRACE_H\n\n#ifdef PZ_DEV\n\nnamespace pz {\n\nextern bool trace_enabled;\n\nvoid trace_instr_(unsigned rsp, const char * instr_name);\n\nvoid trace_instr2_(unsigned rsp, const char * instr_name, int num);\n\nvoid trace_state_(const Heap * heap, void * ip, void * env,\n unsigned rsp, unsigned esp, uint64_t * stack);\n\n} // namespace pz\n\n#define pz_trace_instr(rip, name) \\\n if (pz::trace_enabled) { \\\n pz::trace_instr_(rip, name); \\\n }\n#define pz_trace_instr2(rip, name, num) \\\n if (pz::trace_enabled) { \\\n pz::trace_instr2_(rip, name, num); \\\n }\n#define pz_trace_state(heap, rip, env, rsp, esp, stack) \\\n if (pz::trace_enabled) { \\\n pz::trace_state_(heap, rip, env, rsp, esp, stack); \\\n }\n\n#else /* ! PZ_DEV */\n\n#define pz_trace_instr(rip, name)\n#define pz_trace_instr2(rip, name, num)\n#define pz_trace_state(heap, rip, env, rsp, esp, stack)\n\n#endif /* ! PZ_DEV */\n\n#endif /* ! PZ_TRACE_H */\n" }, { "path": "runtime/pz_util.h", "content": "/*\n * PZ Utils.\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_UTIL_H\n#define PZ_UTIL_H\n\n/*\n * The machine word size.\n */\n#define WORDSIZE_BYTES sizeof(void *)\n\n#if UINTPTR_MAX == 0xFFFFFFFFFFFFFFFF\n#define WORDSIZE_BITS 64\n#elif UINTPTR_MAX == 0xFFFFFFFF\n#define WORDSIZE_BYTES 32\n#else\n#pragma error \"Unknown pointer size\"\n#endif\n\n#if WORDSIZE_BITS == 64\n#define WORDSIZE_HEX_CHARS_STR \"16\"\n#elif WORDSIZE_BITS == 32\n#define WORDSIZE_HEX_CHARS_STR \"8\"\n#endif\n\ntemplate \nconstexpr T RoundUp(T x, T y)\n{\n return ((x + y - 1) / y) * y;\n}\n\ntemplate \nconstexpr T RoundDown(T x, T y)\n{\n return (x / y) * y;\n}\n\nconstexpr size_t AlignUp(size_t x, size_t y)\n{\n return RoundUp(x, y);\n}\n\n#endif /* ! PZ_UTIL_H */\n" }, { "path": "runtime/pz_vector.h", "content": "/*\n * Plasma GC-compatible bounds-checked array\n * vim: ts=4 sw=4 et\n *\n * Copyright (C) Plasma Team\n * Distributed under the terms of the MIT license, see ../LICENSE.code\n */\n\n#ifndef PZ_VECTOR_H\n#define PZ_VECTOR_H\n\n#include \"string.h\"\n\n#include \"pz_gc_util.h\"\n\nnamespace pz {\n\ntemplate \nclass Vector : public GCNew\n{\n private:\n /*\n * The array data is stored seperately. Array types can be\n * passed-by-value and easilly embeded within other values.\n */\n size_t m_len;\n size_t m_capacity;\n T * m_data;\n\n public:\n Vector(NoGCScope & gc, size_t capacity = 8)\n : m_len(0)\n , m_capacity(capacity)\n {\n if (m_capacity > 0) {\n m_data = new (gc) T[m_capacity];\n } else {\n m_data = nullptr;\n }\n }\n\n size_t size() const\n {\n return m_len;\n }\n\n const T & operator[](size_t offset) const\n {\n assert(offset < m_len);\n return m_data[offset];\n }\n\n T & operator[](size_t offset)\n {\n assert(offset < m_len);\n return m_data[offset];\n }\n\n const T & front() const\n {\n assert(m_len > 0);\n return m_data[0];\n }\n\n T & front()\n {\n assert(m_len > 0);\n return m_data[0];\n }\n\n const T & back() const\n {\n assert(m_len > 0);\n return m_data[m_len - 1];\n }\n\n T & back()\n {\n assert(m_len > 0);\n return m_data[m_len - 1];\n }\n\n class Iterator : public std::iterator {\n private:\n const Vector *m_vector;\n size_t m_pos;\n\n protected:\n friend class Vector;\n Iterator(const Vector *v, size_t pos) : m_vector(v), m_pos(pos) {}\n\n public:\n bool operator!=(const Iterator &r) const {\n assert(m_vector == r.m_vector);\n return m_pos != r.m_pos;\n }\n\n Iterator& operator++() {\n m_pos++;\n return *this;\n }\n\n const T& operator*() {\n return (*m_vector)[m_pos];\n };\n };\n\n Iterator begin() const {\n return Iterator(this, 0);\n }\n\n Iterator end() const {\n return Iterator(this, m_len);\n }\n\n bool append(GCCapability & gc_cap, T value)\n {\n if (m_len == m_capacity) {\n if (!grow(gc_cap)) return false;\n }\n \n assert(m_len < m_capacity);\n m_data[m_len++] = value;\n return true;\n }\n\n bool grow(GCCapability & gc_cap)\n {\n if (m_capacity) {\n assert(m_data);\n // TODO: Tune this, right now we double the size of the array.\n // TODO: Implement realloc in the GC (Bug #208).\n T * new_data = new (gc_cap) T[m_capacity * 2];\n if (!new_data) return false;\n for (unsigned i = 0; i < m_len; i++) {\n new_data[i] = m_data[i];\n }\n m_data = new_data;\n m_capacity *= 2;\n } else {\n assert(!m_data);\n m_data = new (gc_cap) T[8];\n m_capacity = 8;\n }\n return true;\n }\n\n /*\n * These are deleted until they're needed (and can be tested) later.\n */\n Vector(const Vector &) = delete;\n void operator=(const Vector &) = delete;\n};\n\n} // namespace pz\n\n#endif /* ! PZ_VECTOR_H */\n" }, { "path": "scripts/README.md", "content": "\n# Scripts\n\n## do\\_mmc\\_make\n\nThe [do_mmc_make](do_mmc_make) script in this directory can be placed in\nthe path and will run the [.vim_mmc_make](../src/.vim_mmc_make) script\nfrom the current directory.\nSuch as the one in the `src` directory. This makes it easy to use `mmc\n--make` from vim by pressing F9 with the following configuration change.\nMake this change to the `ftplugin/mercury.vim` file of Mercury's vim plugin.\n\n setlocal makeprg=do_mmc_make\n\n## docker\n\nThe [docker](docker) directory contains a Dockerfile to setup an environment\nfor developing Plasma. You can build the image for yourself or download it\nfrom [docker hub](https://hub.docker.com/r/paulbone/plasma-dep) with\n\n docker pull paulbone/plasma-dep\n\n" }, { "path": "scripts/do_mmc_make", "content": "#!/bin/sh\n\nif [ -f .vim_mmc_make ]; then\n JOBS=8 exec ./.vim_mmc_make\nelse\n echo \"No .vim_mmc_make file found\"\n exit 1\nfi\n\n" }, { "path": "scripts/docker/Dockerfile", "content": "FROM debian:bullseye\n\n##\n## The first part of this dockerfile is identical to the Mercury one\n## https://github.com/Mercury-Language/packaging/tree/master/docker/min-rotd\n## To improve caching\n#####################################\nRUN apt-get update; apt-get upgrade -yq\n\nWORKDIR /tmp\nCOPY install.sh .\n\n# Install some mercury dependencies, this creates another docker layer\n# allowing some caching.\n\nRUN ./install.sh \\\n gcc \\\n libhwloc-dev \\\n libreadline-dev \\\n perl\n\nCOPY paul.gpg /etc/apt/trusted.gpg.d/paul-6507444DBDF4EAD2.gpg\nCOPY mercury.list /etc/apt/sources.list.d/\n\n# Install a minimal set of Mercury grades\nRUN ./install.sh \\\n mercury-llc-dev \\\n mercury-tools=22.01-bullseye1\n\n#############################\n## End of Mercury dockerfile\n##\n\n##\n## Likewise, this snippet is from the plasma-ci-dep image.\n##\n# Install some Plasma build dependencies. We will test with both gcc and\n# clang so install both.\nRUN ./install.sh \\\n exuberant-ctags \\\n gcc \\\n g++ \\\n clang \\\n make \\\n unzip \\\n ninja-build\n\n# Install the extra dependencies / things someone might want for working on\n# Plasma.\nRUN ./install.sh \\\n asciidoc \\\n ca-certificates \\\n cdecl \\\n git \\\n less \\\n patchutils \\\n pinfo \\\n procps \\\n screen \\\n source-highlight \\\n tig \\\n vim \\\n mercury-recommended\n\n# Setup git and vim.\n# TODO: should be able to do this with vim packages and without the pathogen\n# script.\nWORKDIR /root\nCOPY gitconfig .gitconfig\nCOPY vimrc .vimrc\nRUN mkdir .vim .vim/bundle .vim/autoload\nADD https://raw.githubusercontent.com/tpope/vim-pathogen/master/autoload/pathogen.vim .vim/autoload/pathogen.vim\nRUN cp -r /usr/share/doc/mercury-tools/examples/vim .vim/bundle/mercury\nRUN git clone --depth 1 https://github.com/PlasmaLang/vim.git .vim/bundle/plasma\n# Some of the Mercury vim files may be compressed\nRUN find .vim -name \\*.gz | xargs gunzip\n\n# Get Plasma.\nRUN git clone https://github.com/PlasmaLang/plasma.git\n\n# Update to later git versions.\nWORKDIR .vim/bundle/plasma\nRUN git remote update -p && git checkout fa0dcf83c496b34db22e255a2cfec3bd3ee97812 && git checkout master && git merge --ff origin/master \nWORKDIR /root/plasma \nRUN git remote update -p && git checkout f25d3d2c0f412b230482b43cf8fafaedaee6b844 && git checkout master && git merge --ff origin/master\n\nWORKDIR /root\nRUN apt-get update; apt-get upgrade -yq\n\n# One more tweak to vim.\nRUN cp plasma/scripts/do_mmc_make /usr/bin\nRUN echo \"setlocal makeprg=do_mmc_make\" >> .vim/bundle/mercury/ftplugin/mercury.vim\n\nCOPY welcome.sh /usr/bin\nENTRYPOINT /usr/bin/welcome.sh\n\n" }, { "path": "scripts/docker/README.md", "content": "\nBuild / get a docker image\n==========================\n\nThis directory contains a Dockerfile to setup an environment\nfor developing Plasma. To build the image edit build.sh and then execute\nit: \n\n $ vim build.sh\n $ ./build.sh\n\nOr download it from [docker\nhub](https://hub.docker.com/r/paulbone/plasma-dep) with\n\n $ docker pull paulbone/plasma-dep\n\nYou can run it (it will open a shell prompt) with:\n\n $ docker run -it paulbone/plasma-dep:latest\n\nMore details\n============\n\nThe files in this directory do the following:\n\nREADME.md: You're reading it.\nbuild.sh: A script to ask docker to build the image.\nDockerfile: The Dockerfile (docker's script) to build the image.\n\nThese files are part of the docker image:\n\ngitconfig: A basic ~/.gitconfig\ninstall.sh: A script to call apt within docker\nmercury.list: An apt sources list for Mercury\npaul.gpg: Paul's GPG key (for signed Mercury packages)\nvimrc: A suitable .vimrc with this and options in the docker file\n syntax highlighting will be available for Plasma and Mercury.\nwelcome.sh: A greeting when opening the docker image.\n\n" }, { "path": "scripts/docker/build.sh", "content": "#!/bin/sh\n\nset -e\n\n# Set this to your dockerhub name.\nUSER=paulbone\n\n# The name of the docker image\nIMAGE=plasma-dep\n\n# The version string\nVERSION=latest\n\ndocker build -t $USER/$IMAGE:$VERSION .\n\n# Comment these out if you don't wish to upload the image.\ndocker push $USER/$IMAGE:$VERSION\n\n" }, { "path": "scripts/docker/gitconfig", "content": "[alias]\n\tgraph = log --graph --decorate --oneline\n\n[merge]\n log=1000000\n conflictstyle = diff3\n[fetch]\n prune=true\n[color]\n branch=never\n\n" }, { "path": "scripts/docker/install.sh", "content": "#!/bin/sh\n\nset -e\n\napt-get update\napt-get install --no-install-recommends -yq $*\nrm -rf /var/lib/apt/lists/*\n\n" }, { "path": "scripts/docker/mercury.list", "content": "\ndeb http://dl.mercurylang.org/deb/ bullseye main\ndeb-src http://dl.mercurylang.org/deb/ bullseye main\n\n" }, { "path": "scripts/docker/vimrc", "content": "set wrapmargin=1\nset showmode\nset ts=4 sw=4\nset textwidth=76\nset et\nset autoindent\nset smartindent\nset modeline\nset t_Co=8\nset showmatch\nset exrc\nset showcmd\nfiletype plugin on\nsyntax on\nset background=dark\nset ignorecase\nset smartcase\nset incsearch\nset ruler\nset textauto\nset noerrorbells\n\nlet g:mercury_no_highlight_tabs=1\nlet g:mercury_highlight_comment_special=3\nlet g:mercury_no_highlight_overlong = 1\n\n\"set comments=s1:/*,mb:*,ex:*/,://,b:#,:%,:XCOMM,n:>,fb:-\n\nhighlight PreProc ctermfg=2\nhighlight SpecialKey ctermfg=2\nhighlight Underlined ctermfg=2\nhighlight DiffAdd ctermfg=2\n\n\" Save the buffer before suspending vim, switching buffers, running make etc.\nset autowrite\n\n\" Trim whitespace from the end of lines.\nmap ;x :g/[ ][ ]*$/s//\r\n\n\" compiling \n\" make\n\" next error\n\" previous error\n\nnoremap :mak\nnoremap :cnext\nnoremap :cprev\n\n\" Disable annoying help\nmap \n\n\" Load plugins\nexecute pathogen#infect()\n\n" }, { "path": "scripts/docker/welcome.sh", "content": "#!/bin/sh\n\nset -e\n\ncat << END\n\nWelcome to the Plasma-ready docker image\n----------------------------------------\n\nThis is a docker image ready for Plasma development or testing. It is based\non debian and you may install additional tools with \"apt install\".\n\nThere is a plasma/ subdirectory here. Consult the README.md and/or copy\ntemplate.mk to build.mk to set build parameters. When you're ready type\n\"make\" and \"make test\". Type \"git pull\" to update to the latest version.\n\nVim is configured with Plasma and Mercury language plugins.\n\nSee:\n\n https://github.com/PlasmaLang/plasma/tree/master/scripts/docker\n\nfor more info or to contribute inprovements.\n\nEND\n\nexec /bin/bash\n\n" }, { "path": "src/.gitignore", "content": "*.mh\n*.err\nMercury\nplzasm\nplzbuild\nplzc\nplzdisasm\nplzgeninit\nplzlnk\ntags\n" }, { "path": "src/.vim_mmc_make", "content": "#!/bin/sh\n\nset -e\n\nMCFLAGS=--use-grade-subdirs\n\nfor prog in plzasm plzbuild plzc plzdisasm plzgeninit plzlnk; do\n mmc --output-compile-error-lines 1000 \\\n --max-error-line-width 1000 \\\n $MCFLAGS -j$JOBS --make $prog\ndone\n\n\n" }, { "path": "src/Mercury.options", "content": "\n# CFLAGS for mmc --make to pass to the C compiler.\nEXTRA_CFLAGS=-std=c99\n\n# Uncomment this to enable extra warnings & warnings-as-errors. \n# MCFLAGS+=--halt-at-warn \\\n# --warn-dead-procs \\\n# \t--warn-unused-imports \\\n# \t--warn-interface-imports-in-parents \\\n# \t--warn-insts-with-functors-without-type \\\n# \t--warn-inconsistent-pred-order-clauses \\\n# \t--warn-inconsistent-pred-order-foreign-procs \\\n# \t--warn-non-contiguous-foreign-procs \\\n# \t--warn-suspicious-foreign-procs \\\n# \t--warn-suspicious-foreign-code\n\n# You should not need ot modify these options.\nEXTRA_CFLAGS+=-I../runtime/\n\nMCFLAGS-lex=--no-halt-at-warn \\\n\t--no-warn-unused-imports \\\n\t--no-warn-interface-imports-in-parents \\\n\t--no-warn-insts-with-functors-without-type \\\n\t--no-warn-inconsistent-pred-order-clauses \\\n\t--no-warn-inconsistent-pred-order-foreign-procs\nMCFLAGS-lex.automata=--no-halt-at-warn \\\n\t--no-warn-insts-with-functors-without-type\nMCFLAGS-lex.buf=--no-halt-at-warn \\\n\t--no-warn-insts-with-functors-without-type\nMCFLAGS-lex.convert_NFA_to_DFA=--no-halt-at-warn \\\n --no-warn-unused-imports\nMCFLAGS-lex.lexeme=--no-halt-at-warn \\\n\t--no-warn-insts-with-functors-without-type\nMCFLAGS-lex.regexp=--no-halt-at-warn \\\n --no-warn-unused-imports\n\n" }, { "path": "src/README.md", "content": "# Plasma tools directory\n\nThe code in this directory builds the plzc and plzasm programs. plzc\nis the plasma compiler and plzasm will assemble a .pz file from a .pzt\n(plasma bytecode text) file.\n\nThe bytecode assembler has three stages, parsing the source to an `asm`\nstructure, assembling this to a `pz` structure, and writing out the `pz`\nstructure. Some files/modules are:\n\n* [plzasm.m](plzasm.m) - The plasma bytecode assembler entry point\n* [pzt\\_parse.m](pzt\\_parse.m) - The pzt parser\n* asm - These modules contain structures and code used to represent code\n during assembly by plzasm\n\nThe compiler parses the code to an `ast` structure, transforms that to the\n`core` structure, performs semantic analysis and compilation on the `core`\nstructure before generating code as a `pz` structure and writing out the\n`pz` structure. This version of the compiler does not perform any\noptimisations, most optimisations would be done within the `core` phase.\n\n* [plzc.m](plzc.m) - The plasma compiler entry point\n* [parse.m](parse.m) - The plasma parser\n* [ast.m](ast.m) - The plasma abstract syntax tree\n* [pre.m](pre.m) - The pre-core representation\n* [pre.from\\_ast.m](pre.from\\_ast.m) - The translation between the AST and\n pre-core representations\n* [pre.to\\_core.m](pre.to\\_core.m) - The translation between the pre-core\n and core representations\n* [core.m](core.m and sub-modules) - These modules contain the core\n structure and code that performs\n semantic analysis.\n* [core\\_to\\_pz.m](core\\_to\\_pz.m and sub-modules) -\n Code to transform `core` to `pz`\n\nThe linker links one or more compiled Plasma files (.pzo) into a program.\n* [plzlnk.m](plzlnk.m)\n\nOther tools\n* [plzdisasm.m](plzdisasm.m) Plasma disassembler.\n\nSome files/modules shared between several tools are:\n\n* [lex.m](lex.m) -\n This library is part of the Mercury extras distribution and\n provides code to build a lexical analyser\n* [parsing.m](parsing.m) - Code to build table based LL(2) parsers\n* [pz.m](pz.m and sub-modules) - Code to represent and write out PZ format\n bytecode\n\n" }, { "path": "src/asm.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module asm.\n%\n% Assemble a PZ bytecode file.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module asm_ast.\n:- import_module asm_error.\n:- import_module pz.\n:- import_module pz.pz_ds.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- pred assemble(asm::in, result(pz, asm_error)::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module bimap.\n:- import_module cord.\n:- import_module digraph.\n:- import_module int.\n:- import_module int32.\n:- import_module list.\n:- import_module map.\n:- import_module maybe.\n:- import_module require.\n:- import_module set.\n:- import_module string.\n:- import_module uint32.\n\n:- import_module constant.\n:- import_module context.\n:- import_module common_types.\n:- import_module pz.code.\n:- import_module q_name.\n:- import_module util.my_exception.\n:- import_module util.path.\n\n%-----------------------------------------------------------------------%\n\nassemble(PZT, MaybePZ) :-\n some [!PZ, !Errors] (\n ( if\n filename_extension(constant.pz_text_extension, PZT ^ asm_filename,\n ModuleNameStr)\n then\n ModuleName = q_name_single(ModuleNameStr)\n else\n ModuleName = q_name_single(PZT ^ asm_filename)\n ),\n !:PZ = init_pz([ModuleName], pzft_object),\n Items = PZT ^ asm_items,\n\n % Add a data item to store the source file name.\n pz_new_data_id(CtxtFileDataId, !PZ),\n pz_add_data(CtxtFileDataId, pz_encode_string(PZT ^ asm_filename), !PZ),\n\n prepare_map(Items, SymbolMap, StructMap, !PZ),\n !:Errors = init,\n foldl2(build_items(SymbolMap, StructMap, CtxtFileDataId), Items,\n !PZ, !Errors),\n ( is_empty(!.Errors) ->\n MaybePZ = ok(!.PZ)\n ;\n MaybePZ = errors(!.Errors)\n )\n ).\n\n:- pred prepare_map(list(asm_item)::in, bimap(q_name, pz_item_id)::out,\n map(string, pzs_id)::out, pz::in, pz::out) is det.\n\nprepare_map(Items, !:SymbolMap, StructMap, !PZ) :-\n some [!Graph] (\n digraph.init(!:Graph),\n filter_map((pred(Item::in, Data::out) is semidet :-\n Item = asm_item(Name, Context, asm_data(Type, Value)),\n Data = asm_item_data(Name, Context, Type, Value)\n ), Items, DataItems),\n\n DataNames = list_to_set(map(func(Data) = Data ^ aid_name, DataItems)),\n foldl(build_data_graph(DataNames), DataItems, !Graph),\n !:SymbolMap = bimap.init,\n ( if return_vertices_in_to_from_order(!.Graph, NamesOrdered) then\n foldl2((pred(Name::in, S0::in, S::out, PZ0::in, PZ::out) is det :-\n pz_new_data_id(DID, PZ0, PZ),\n ID = pzii_data(DID),\n ( if insert(Name, ID, S0, S1) then\n S = S1\n else\n compile_error($file, $pred, \"Duplicate data name\")\n )\n ), NamesOrdered, !SymbolMap, !PZ)\n else\n compile_error($file, $pred, \"Data contains cycles\")\n ),\n\n foldl3(prepare_map_2, Items, !SymbolMap, map.init, StructMap,\n !PZ)\n ).\n\n:- type asm_item_data\n ---> asm_item_data(\n aid_name :: q_name,\n aid_context :: context,\n aid_type :: asm_data_type,\n aid_value :: list(asm_data_value)\n ).\n\n:- pred build_data_graph(set(q_name)::in, asm_item_data::in,\n digraph(q_name)::in, digraph(q_name)::out) is det.\n\nbuild_data_graph(DataNames, Data, !Graph) :-\n Name = Data ^ aid_name,\n add_vertex(Name, NameKey, !Graph),\n foldl((pred(Item::in, G0::in, G::out) is det :-\n ( Item = asm_dvalue_num(_),\n G = G0\n ; Item = asm_dvalue_name(Ref),\n ( if member(Ref, DataNames) then\n % Only add this edge if the referred-to thing is itself\n % data.\n add_vertex(Ref, RefKey, G0, G1),\n add_edge(NameKey, RefKey, G1, G)\n else\n G = G0\n )\n )\n ), Data ^ aid_value, !Graph).\n\n:- pred prepare_map_2(asm_item::in, bimap(q_name, pz_item_id)::in,\n bimap(q_name, pz_item_id)::out,\n map(string, pzs_id)::in, map(string, pzs_id)::out,\n pz::in, pz::out) is det.\n\nprepare_map_2(asm_item(QName, Context, Type), !SymMap, !StructMap, !PZ) :-\n (\n ( Type = asm_proc(_, _),\n pz_new_proc_id(PID, !PZ),\n ID = pzii_proc(PID)\n ; Type = asm_closure(_, _, _),\n pz_new_closure_id(CID, !PZ),\n ID = pzii_closure(CID)\n ; Type = asm_import(_),\n pz_new_import(IID, pz_import(QName, pzit_import), !PZ),\n ID = pzii_import(IID)\n ),\n ( if insert(QName, ID, !SymMap) then\n true\n else\n compile_error($file, $pred, Context, \"Duplicate name\")\n )\n ; Type = asm_struct(Fields),\n ( if q_name_parts(QName, no, Name) then\n pz_new_struct_id(SID, nq_name_to_string(Name), !PZ),\n pz_add_struct(SID, pz_struct(Fields), !PZ),\n ( if insert(nq_name_to_string(Name), SID, !StructMap) then\n true\n else\n compile_error($file, $pred, Context, \"Duplicate struct name\")\n )\n else\n compile_error($file, $pred, Context, \"Qualified struct name\")\n )\n ; Type = asm_data(_, _)\n % Already handled above.\n ).\nprepare_map_2(asm_entrypoint(_, _), !SymMap, !StructMap, !PZ).\n\n:- pred build_items(bimap(q_name, pz_item_id)::in, map(string, pzs_id)::in,\n pzd_id::in, asm_item::in, pz::in, pz::out,\n errors(asm_error)::in, errors(asm_error)::out) is det.\n\nbuild_items(SymbolMap, StructMap, CtxtStrData, asm_item(Name, Context, Type),\n !PZ, !Errors) :-\n (\n ( Type = asm_proc(_, _)\n ; Type = asm_data(_, _)\n ; Type = asm_closure(_, _, _)\n ),\n bimap.lookup(SymbolMap, Name, ID),\n ( Type = asm_proc(Signature, Blocks0),\n PID = item_expect_proc($file, $pred, ID),\n list.foldl3(build_block_map, Blocks0, 0u32, _, map.init, BlockMap,\n init, BlockErrors),\n Info = asm_info(SymbolMap, BlockMap, StructMap, CtxtStrData),\n ( is_empty(BlockErrors) ->\n map(build_block(Info), Blocks0, MaybeBlocks0),\n result_list_to_result(MaybeBlocks0, MaybeBlocks)\n ;\n MaybeBlocks = errors(BlockErrors)\n ),\n ( MaybeBlocks = ok(Blocks),\n pz_add_proc(PID, pz_proc(Name, Signature, yes(Blocks)),\n !PZ)\n ; MaybeBlocks = errors(Errors),\n add_errors(Errors, !Errors)\n )\n ; Type = asm_data(ASMDType, ASMValues),\n DID = item_expect_data($file, $pred, ID),\n DType = build_data_type(StructMap, ASMDType, ASMValues),\n ( DType = type_struct(PZSId),\n pz_lookup_struct(!.PZ, PZSId) = pz_struct(Widths),\n ( if length(Widths) = length(ASMValues) `with_type` int then\n true\n else\n compile_error($file, $pred, Context,\n \"Data length doesn't match struct length\")\n )\n ; DType = type_array(_, _)\n ; DType = type_string(_)\n ),\n Values = map(build_data_value(SymbolMap), ASMValues),\n pz_add_data(DID, pz_data(DType, Values), !PZ)\n ; Type = asm_closure(ProcName, DataName, Sharing),\n CID = item_expect_closure($file, $pred, ID),\n Closure = build_closure(SymbolMap, ProcName, DataName),\n pz_add_closure(CID, Closure, !PZ),\n ( Sharing = s_public,\n q_name_parts(Name, MaybeModule, _),\n ( if\n ( MaybeModule = yes(Module),\n member(Module, pz_get_module_names(!.PZ))\n ; MaybeModule = no\n )\n then\n pz_export_closure(CID, Name, !PZ)\n else\n my_exception.sorry($file, $pred,\n \"Module can't yet export other modules' symbols\")\n )\n ; Sharing = s_private\n )\n )\n ; Type = asm_struct(_)\n ; Type = asm_import(_)\n ).\nbuild_items(Map, _StructMap, _, asm_entrypoint(_, Name), !PZ, !Errors) :-\n lookup(Map, Name, ID),\n CID = item_expect_closure($file, $pred, ID),\n pz_add_entry_candidate(CID, pz_es_plain, !PZ).\n\n:- pred build_block_map(pzt_block::in, pzb_id::in, pzb_id::out,\n map(string, pzb_id)::in, map(string, pzb_id)::out,\n errors(asm_error)::in, errors(asm_error)::out) is det.\n\nbuild_block_map(pzt_block(Name, _, Context), !Num, !Map, !Errors) :-\n ( map.insert(Name, !.Num, !Map) ->\n true\n ;\n add_error(Context, e_name_already_defined(Name), !Errors)\n ),\n !:Num = !.Num + 1u32.\n\n:- type asm_info\n ---> asm_info(\n ai_symbols :: bimap(q_name, pz_item_id),\n ai_blocks :: map(string, pzb_id),\n ai_structs :: map(string, pzs_id),\n\n % The string data for the filename part of context\n % information.\n ai_context_string :: pzd_id\n ).\n\n:- pred build_block(asm_info::in, pzt_block::in,\n result(pz_block, asm_error)::out) is det.\n\nbuild_block(Info, pzt_block(_, Instrs0, _), MaybeBlock) :-\n map(build_instruction(Info), Instrs0, MaybeInstrs0),\n result_list_to_result(MaybeInstrs0, MaybeInstrs1),\n MaybeInstrs = result_map(condense, MaybeInstrs1),\n MaybeBlock = result_map((func(X) = pz_block(X)), MaybeInstrs).\n\n:- pred build_instruction(asm_info::in, pzt_instruction::in,\n result(list(pz_instr_obj), asm_error)::out) is det.\n\nbuild_instruction(Info, pzt_instruction(Instr, Widths0, Context),\n MaybeInstrs) :-\n default_widths(Widths0, Width1, Width2),\n build_instruction(Info, Context, Instr, Width1, Width2, MaybeInstr),\n ( if is_nil_context(Context) then\n PZContext = pz_nil_context\n else\n PZContext = pz_context(Context, Info ^ ai_context_string)\n ),\n MaybeInstrs = result_map(\n func(X) = [pzio_context(PZContext), pzio_instr(X)],\n MaybeInstr).\n\n:- pred default_widths(pzt_instruction_widths::in, pz_width::out,\n pz_width::out) is det.\n\ndefault_widths(no, pzw_fast, pzw_fast).\ndefault_widths(one_width(Width), Width, pzw_fast).\ndefault_widths(two_widths(Width1, Width2), Width1, Width2).\n\n:- pred build_instruction(asm_info::in, context::in, pzt_instruction_code::in,\n pz_width::in, pz_width::in, result(pz_instr, asm_error)::out) is det.\n\nbuild_instruction(Info, Context, PInstr,\n Width1, Width2, MaybeInstr) :-\n ( PInstr = pzti_load_immediate(N),\n % TODO: Encode the immediate value with a more suitable width.\n MaybeInstr = ok(pzi_load_immediate(Width1, im_i32(det_from_int(N))))\n ; PInstr = pzti_word(Name),\n ( if\n builtin_instr(Name, Width1, Width2, Instr)\n then\n MaybeInstr = ok(Instr)\n else\n MaybeInstr = return_error(Context, e_no_such_instruction(Name))\n )\n ; PInstr = pzti_jmp(Name),\n ( search(Info ^ ai_blocks, Name, Num) ->\n MaybeInstr = ok(pzi_jmp(Num))\n ;\n MaybeInstr = return_error(Context, e_block_not_found(Name))\n )\n ; PInstr = pzti_cjmp(Name),\n ( search(Info ^ ai_blocks, Name, Num) ->\n MaybeInstr = ok(pzi_cjmp(Num, Width1))\n ;\n MaybeInstr = return_error(Context, e_block_not_found(Name))\n )\n ; PInstr = pzti_call(QName),\n ( if\n search(Info ^ ai_symbols, QName, Entry),\n ( Entry = pzii_closure(CID),\n Callee = pzc_closure(CID)\n ; Entry = pzii_proc(PID),\n Callee = pzc_proc_opt(PID)\n ; Entry = pzii_import(ImportId),\n Callee = pzc_import(ImportId)\n )\n then\n MaybeInstr = ok(pzi_call(Callee))\n else\n MaybeInstr = return_error(Context, e_symbol_not_found(QName))\n )\n ; PInstr = pzti_tcall(QName),\n ( if\n search(Info ^ ai_symbols, QName, Entry),\n ( Entry = pzii_proc(PID),\n Callee = pzc_proc_opt(PID)\n ; Entry = pzii_closure(CID),\n Callee = pzc_closure(CID)\n )\n then\n MaybeInstr = ok(pzi_tcall(Callee))\n else\n MaybeInstr = return_error(Context, e_symbol_not_found(QName))\n )\n ;\n ( PInstr = pzti_roll(Depth)\n ; PInstr = pzti_pick(Depth)\n ),\n ( Depth =< 255 ->\n ( PInstr = pzti_roll(_),\n Instr = pzi_roll(Depth)\n ; PInstr = pzti_pick(_),\n Instr = pzi_pick(Depth)\n ),\n MaybeInstr = ok(Instr)\n ;\n MaybeInstr = return_error(Context, e_stack_depth)\n )\n ;\n ( PInstr = pzti_alloc(Name)\n ; PInstr = pzti_load(Name, _)\n ; PInstr = pzti_store(Name, _)\n ),\n ( if search(Info ^ ai_structs, Name, StructId) then\n ( PInstr = pzti_alloc(_),\n MaybeInstr = ok(pzi_alloc(StructId))\n ; PInstr = pzti_load(_, Field),\n % TODO: Use the width from the structure and don't allow a\n % custom one.\n MaybeInstr = ok(pzi_load(StructId, Field, Width1))\n ; PInstr = pzti_store(_, Field),\n MaybeInstr = ok(pzi_store(StructId, Field, Width1))\n )\n else\n MaybeInstr = return_error(Context, e_struct_not_found(Name))\n )\n ; PInstr = pzti_make_closure(QName),\n ( if\n search(Info ^ ai_symbols, QName, Entry),\n Entry = pzii_proc(PID)\n then\n MaybeInstr = ok(pzi_make_closure(PID))\n else\n MaybeInstr = return_error(Context, e_symbol_not_found(QName))\n )\n ).\n\n % Identifiers that are builtin instructions.\n %\n:- pred builtin_instr(string::in, pz_width::in, pz_width::in,\n pz_instr::out) is semidet.\n\nbuiltin_instr(\"ze\", W1, W2, pzi_ze(W1, W2)).\nbuiltin_instr(\"se\", W1, W2, pzi_se(W1, W2)).\nbuiltin_instr(\"trunc\", W1, W2, pzi_trunc(W1, W2)).\nbuiltin_instr(\"add\", W1, _, pzi_add(W1)).\nbuiltin_instr(\"sub\", W1, _, pzi_sub(W1)).\nbuiltin_instr(\"mul\", W1, _, pzi_mul(W1)).\nbuiltin_instr(\"div\", W1, _, pzi_div(W1)).\nbuiltin_instr(\"and\", W1, _, pzi_and(W1)).\nbuiltin_instr(\"or\", W1, _, pzi_or(W1)).\nbuiltin_instr(\"xor\", W1, _, pzi_xor(W1)).\nbuiltin_instr(\"dup\", _, _, pzi_dup).\nbuiltin_instr(\"drop\", _, _, pzi_drop).\nbuiltin_instr(\"swap\", _, _, pzi_swap).\nbuiltin_instr(\"lt_u\", W1, _, pzi_lt_u(W1)).\nbuiltin_instr(\"lt_s\", W1, _, pzi_lt_s(W1)).\nbuiltin_instr(\"gt_u\", W1, _, pzi_gt_u(W1)).\nbuiltin_instr(\"gt_s\", W1, _, pzi_gt_s(W1)).\nbuiltin_instr(\"eq\", W1, _, pzi_eq(W1)).\nbuiltin_instr(\"not\", W1, _, pzi_not(W1)).\nbuiltin_instr(\"ret\", _, _, pzi_ret).\nbuiltin_instr(\"call_ind\", _, _, pzi_call_ind).\nbuiltin_instr(\"tcall_ind\", _, _, pzi_tcall_ind).\nbuiltin_instr(\"get_env\", _, _, pzi_get_env).\n\n%-----------------------------------------------------------------------%\n\n:- func build_data_type(map(string, pzs_id), asm_data_type, list(T)) =\n pz_data_type.\n\nbuild_data_type(_, asm_dtype_array(Width), Values) =\n type_array(Width, length(Values)).\nbuild_data_type(Map, asm_dtype_struct(Name), _) = type_struct(ID) :-\n ( if map.search(Map, Name, IDPrime) then\n ID = IDPrime\n else\n compile_error($file, $pred,\n format(\"Unknown data type: '%s'\", [s(Name)]))\n ).\nbuild_data_type(_, asm_dtype_string, Values) =\n type_string(length(Values)).\n\n:- func build_data_value(bimap(q_name, pz_item_id), asm_data_value) =\n pz_data_value.\n\nbuild_data_value(_, asm_dvalue_num(Num)) = pzv_num(Num).\nbuild_data_value(Map, asm_dvalue_name(Name)) = Value :-\n ( if search(Map, Name, ID) then\n ( ID = pzii_proc(_),\n compile_error($file, $pred,\n \"Can't store proc references in data yet\")\n ; ID = pzii_data(DID),\n Value = pzv_data(DID)\n ; ID = pzii_closure(CID),\n Value = pzv_closure(CID)\n ; ID = pzii_import(IID),\n Value = pzv_import(IID)\n )\n else\n compile_error($file, $pred,\n format(\"Unknown data name: '%s'\", [s(q_name_to_string(Name))]))\n ).\n\n:- func build_closure(bimap(q_name, pz_item_id), string, string) = pz_closure.\n\nbuild_closure(Map, ProcName, DataName) = Closure :-\n ( if\n search(Map, q_name_single(ProcName), ProcEntry),\n ProcEntry = pzii_proc(ProcPrime)\n then\n Proc = ProcPrime\n else\n compile_error($file, $pred,\n format(\"Unknown procedure name: '%s'\", [s(ProcName)]))\n ),\n ( if\n search(Map, q_name_single(DataName), DataEntry),\n DataEntry = pzii_data(DataPrime)\n then\n Data = DataPrime\n else\n compile_error($file, $pred,\n format(\"Unknown data name: '%s'\", [s(DataName)]))\n ),\n Closure = pz_closure(Proc, Data).\n\n%-----------------------------------------------------------------------%\n\n:- type pz_item_id\n ---> pzii_proc(pzp_id)\n ; pzii_data(pzd_id)\n ; pzii_closure(pzc_id)\n ; pzii_import(pzi_id).\n\n:- func item_expect_proc(string, string, pz_item_id) = pzp_id.\n\nitem_expect_proc(File, Pred, ID) =\n ( if ID = pzii_proc(Proc) then\n Proc\n else\n unexpected(File, Pred, \"Expected proc\")\n ).\n\n:- func item_expect_data(string, string, pz_item_id) = pzd_id.\n\nitem_expect_data(File, Pred, ID) =\n ( if ID = pzii_data(Data) then\n Data\n else\n unexpected(File, Pred, \"Expected data\")\n ).\n\n:- func item_expect_closure(string, string, pz_item_id) = pzc_id.\n\nitem_expect_closure(File, Pred, ID) =\n ( if ID = pzii_closure(Closure) then\n Closure\n else\n unexpected(File, Pred, \"Expected closure\")\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/asm_ast.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module asm_ast.\n%\n% AST for PZ Textual representation.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module list.\n\n:- import_module common_types.\n:- import_module context.\n:- import_module pz.\n:- import_module pz.code.\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\n:- type asm\n ---> asm(\n asm_module :: q_name,\n asm_filename :: string,\n asm_items :: asm_items\n ).\n\n:- type asm_items\n == list(asm_item).\n\n % Everything is defined at the same \"global entry\" level in the same\n % namespace: a procedure and some static data cannot have the same name.\n % When that name is used we can decide what to do depending on the entry\n % type.\n %\n % Visibility rules will be added later.\n %\n:- type asm_item\n ---> asm_item(\n asmi_name :: q_name,\n asmi_context :: context,\n asmi_type :: entry_type\n )\n ; asm_entrypoint(\n asme_context :: context,\n asme_name :: q_name\n ).\n\n % There are currently two entry types.\n %\n:- type entry_type\n % A procedure\n ---> asm_proc(\n asmp_sig :: pz_signature,\n asmp_blocks :: list(pzt_block)\n )\n % A procedure import\n ; asm_import(\n asmpd_sig :: pz_signature\n )\n % A structure\n ; asm_struct(\n asms_fields :: list(pz_width)\n )\n % Global data\n ; asm_data(\n asmd_type :: asm_data_type,\n asmd_value :: list(asm_data_value)\n )\n ; asm_closure(\n asmc_proc :: string,\n asmc_data :: string,\n asmc_sharing :: sharing\n ).\n\n:- type asm_data_type\n ---> asm_dtype_array(pz_width)\n % Note that this is a string and it is not possible to refer to\n % structs in other modules.\n ; asm_dtype_struct(string)\n ; asm_dtype_string.\n\n:- type asm_data_value\n ---> asm_dvalue_num(int)\n ; asm_dvalue_name(q_name).\n\n%-----------------------------------------------------------------------%\n%\n% Procedures\n%\n\n:- type pzt_block\n ---> pzt_block(\n pztb_name :: string,\n pztb_instrs :: list(pzt_instruction),\n pztb_context :: context\n ).\n\n:- type pzt_instruction\n ---> pzt_instruction(\n pzti_instr :: pzt_instruction_code,\n pzti_widths :: pzt_instruction_widths,\n pzti_context :: context\n ).\n\n % Instructions such as \"add\" although not really implemented as calls in\n % the runtime, look like calls in this structure. They use pzti_word.\n % Instructions that require special handling by the parser are handled\n % specifically.\n %\n:- type pzt_instruction_code\n ---> pzti_word(string)\n\n % Call instructions are handled specifically because it'll be\n % easier when we introduce tail calls.\n ; pzti_call(q_name)\n ; pzti_tcall(q_name)\n\n % These instructions are handled specifically because the have\n % immediate values.\n ; pzti_load_immediate(int)\n ; pzti_jmp(string)\n ; pzti_cjmp(string)\n ; pzti_roll(int)\n ; pzti_pick(int)\n ; pzti_alloc(string)\n ; pzti_make_closure(q_name)\n ; pzti_load(string, field_num)\n ; pzti_store(string, field_num).\n\n:- type pzt_instruction_widths\n ---> no\n ; one_width(pz_width)\n ; two_widths(pz_width, pz_width).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/asm_error.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module asm_error.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Error type for the PZ assembler.\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module parse_util.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- type asm_error\n ---> e_read_src_error(read_src_error)\n ; e_name_already_defined(string)\n ; e_no_such_instruction(string)\n ; e_symbol_not_found(q_name)\n ; e_block_not_found(string)\n ; e_struct_not_found(string)\n ; e_import_not_found(q_name)\n ; e_stack_depth.\n\n:- instance error(asm_error).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module list.\n:- import_module string.\n\n:- import_module util.pretty.\n\n%-----------------------------------------------------------------------%\n\n:- instance error(asm_error) where [\n pred(pretty/4) is asme_pretty,\n func(error_or_warning/1) is asme_error_or_warning\n ].\n\n:- pred asme_pretty(string::in, asm_error::in, list(pretty)::out, list(pretty)::out) is det.\n\nasme_pretty(SrcPath, Error, Para, Extra) :-\n ( Error = e_read_src_error(ReadSrcError),\n pretty(SrcPath, ReadSrcError, Para, Extra)\n ;\n ( Error = e_name_already_defined(Name),\n Para = [p_quote(\"\\\"\", p_str(Name))] ++ p_spc_nl ++\n p_words(\"is already defined\")\n ; Error = e_no_such_instruction(Name),\n Para = [p_quote(\"\\\"\", p_str(Name))] ++ p_spc_nl ++\n p_words(\"is not a PZ instruction\")\n ; Error = e_symbol_not_found(Symbol),\n Para = p_words(\"The symbol\") ++ p_spc_nl ++\n [p_quote(\"\\\"\", q_name_pretty(Symbol))] ++ p_spc_nl ++\n p_words(\"is undefined\")\n ; Error = e_block_not_found(Name),\n Para = p_words(\"The block\") ++ p_spc_nl ++\n [p_quote(\"\\\"\", p_str(Name))] ++ p_spc_nl ++\n p_words(\"is undefined\")\n ; Error = e_struct_not_found(Name),\n Para = p_words(\"The structure\") ++ p_spc_nl ++\n [p_quote(\"\\\"\", p_str(Name))] ++ p_spc_nl ++\n p_words(\"is undefined\")\n ; Error = e_stack_depth,\n Para = p_words(\"Stack operations have a maximum depth of 255\")\n ; Error = e_import_not_found(Symbol),\n Para = p_words(\"The symbol\") ++ p_spc_nl ++\n [p_quote(\"\\\"\", q_name_pretty(Symbol))] ++ p_spc_nl ++\n p_words(\"cannot be found or is not an imported procedure\")\n ),\n Extra = []\n ).\n\n:- func asme_error_or_warning(asm_error) = error_or_warning.\n\nasme_error_or_warning(_) = error.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/ast.m", "content": "%-----------------------------------------------------------------------%\n% Plasma AST\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module represents the AST for plasma programs.\n%\n%-----------------------------------------------------------------------%\n:- module ast.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module list.\n:- import_module maybe.\n\n:- import_module common_types.\n:- import_module context.\n:- import_module q_name.\n:- import_module varmap.\n\n:- type ast == ast(ast_entry).\n:- type ast(E)\n ---> ast(\n a_module_name :: q_name,\n % Context of module declaration.\n a_context :: context,\n a_entries :: list(E)\n ).\n\n% AST for include files.\n:- type ast_interface == ast(ast_interface_entry).\n\n% AST for typeres files.\n:- type ast_typeres == ast(ast_typeres_entry).\n\n:- type ast_entry\n ---> ast_import(ast_import)\n ; ast_type(nq_name, ast_type(nq_name))\n ; ast_resource(nq_name, ast_resource)\n ; ast_function(nq_name, ast_function)\n ; ast_pragma(ast_pragma).\n\n:- type ast_interface_entry\n ---> asti_resource(\n q_name,\n\n % Opaque resources won't have a definition.\n maybe(ast_resource)\n )\n ; asti_type(q_name, ast_type(q_name))\n ; asti_function(q_name, ast_function_decl).\n\n:- type ast_typeres_entry\n ---> asti_resource_abs(q_name)\n ; asti_type_abs(q_name, arity).\n\n:- type ast_import\n ---> ast_import(\n ai_name :: q_name,\n ai_as :: maybe(string),\n ai_context :: context\n ).\n\n:- type ast_type(Name)\n ---> ast_type(\n at_params :: list(string),\n at_costructors :: list(at_constructor(Name)),\n at_export :: sharing_opaque,\n at_context :: context\n )\n % An abstractly-imported type.\n % This module has no knowledge of the constructors and\n % these are always st_private.\n ; ast_type_abstract(\n ata_arity :: arity,\n ata_context :: context\n ).\n\n:- type ast_resource\n ---> ast_resource(\n ar_from :: q_name,\n ar_sharing :: sharing_opaque,\n ar_context :: context\n ).\n\n:- type ast_function_decl\n ---> ast_function_decl(\n afd_params :: list(ast_param),\n afd_return :: list(ast_type_expr),\n afd_uses :: list(ast_uses),\n afd_context :: context\n ).\n\n:- type ast_function\n ---> ast_function(\n af_decl :: ast_function_decl,\n af_body :: ast_body,\n af_export :: sharing,\n af_is_entrypoint :: is_entrypoint\n ).\n\n:- type ast_body\n ---> ast_body_block(\n list(ast_block_thing)\n )\n ; ast_body_foreign(\n abf_foreign_sym :: string\n ).\n\n:- type ast_block_thing(Info)\n ---> astbt_statement(ast_statement(Info))\n ; astbt_function(nq_name, ast_nested_function).\n\n:- type ast_block_thing == ast_block_thing(context).\n\n:- type ast_nested_function\n ---> ast_nested_function(\n anf_decl :: ast_function_decl,\n anf_body :: list(ast_block_thing)\n ).\n\n%\n% Modules, imports and exports.\n%\n:- type export_some_or_all\n ---> export_some(list(string))\n ; export_all.\n\n%\n% Types\n%\n:- type at_constructor(Name)\n ---> at_constructor(\n atc_name :: Name,\n atc_args :: list(at_field),\n atc_context :: context\n ).\n\n:- type at_field\n ---> at_field(\n atf_name :: string,\n atf_type :: ast_type_expr,\n atf_context :: context\n ).\n\n:- type ast_type_expr\n ---> ast_type(\n ate_name :: q_name,\n ate_args :: list(ast_type_expr),\n ate_context :: context\n )\n ; ast_type_func(\n atf_args :: list(ast_type_expr),\n atf_returns :: list(ast_type_expr),\n atf_uses :: list(ast_uses),\n atf_context_ :: context\n )\n ; ast_type_var(\n atv_name :: string,\n atv_context :: context\n ).\n\n%\n% Code signatures\n%\n:- type ast_param\n ---> ast_param(\n ap_name :: var_or_wildcard(string),\n ap_type :: ast_type_expr\n ).\n\n:- type ast_uses\n ---> ast_uses(\n au_uses_type :: uses_type,\n au_name :: q_name\n ).\n\n:- type uses_type\n ---> ut_uses\n ; ut_observes.\n\n%\n% Code\n%\n:- type ast_statement(Info)\n ---> ast_statement(\n ast_stmt_type :: ast_stmt_type(Info),\n ast_stmt_info :: Info\n ).\n\n:- type ast_statement == ast_statement(context).\n\n:- type ast_stmt_type(Info)\n % A statement that looks like a call must be a call, it cannot\n % be a construction as that would have no effect.\n ---> s_call(ast_call_like)\n ; s_assign_statement(\n as_ast_vars :: list(ast_pattern),\n as_expr :: list(ast_expression)\n )\n ; s_array_set_statement(\n sas_array :: string,\n sas_subscript :: ast_expression,\n sas_rhs :: ast_expression\n )\n ; s_return_statement(list(ast_expression))\n ; s_var_statement(\n vs_vars :: string\n )\n ; s_match_statement(\n sms_expr :: ast_expression,\n sms_cases :: list(ast_match_case(Info))\n )\n ; s_ite(\n psi_cond :: ast_expression,\n psi_then :: list(ast_block_thing(Info)),\n psi_else :: list(ast_block_thing(Info))\n ).\n\n:- type ast_match_case(Info)\n ---> ast_match_case(\n c_pattern :: ast_pattern,\n c_stmts :: list(ast_block_thing(Info))\n ).\n\n:- type ast_match_case == ast_match_case(context).\n\n:- type ast_expression\n ---> e_call_like(\n ec_call_like :: ast_call_like\n )\n ; e_u_op(\n euo_op :: ast_uop,\n euo_expr :: ast_expression\n )\n ; e_b_op(\n ebo_expr_left :: ast_expression,\n ebo_op :: ast_bop,\n ebo_expr_right :: ast_expression\n )\n ; e_match(\n em_expr :: ast_expression,\n em_cases :: list(ast_expr_match_case)\n )\n ; e_if(\n eif_cond :: ast_expression,\n eif_then :: list(ast_expression),\n eif_else :: list(ast_expression)\n )\n ; e_symbol(\n es_name :: q_name\n )\n ; e_const(\n ec_value :: ast_const\n )\n ; e_array(\n ea_values :: list(ast_expression)\n ).\n\n:- type ast_uop\n ---> u_minus\n ; u_not.\n\n:- type ast_bop\n ---> b_add\n ; b_sub\n ; b_mul\n ; b_div\n ; b_mod\n ; b_lt\n ; b_gt\n ; b_lteq\n ; b_gteq\n ; b_eq\n ; b_neq\n ; b_logical_and\n ; b_logical_or\n ; b_concat\n ; b_list_cons\n ; b_array_subscript.\n\n:- type ast_expr_match_case\n ---> ast_emc(ast_pattern, list(ast_expression)).\n\n:- type ast_const\n ---> c_number(int)\n ; c_string(string)\n ; c_list_nil.\n\n % A call or call-like thing (such as a construction).\n %\n:- type ast_call_like\n ---> ast_call_like(\n ec_callee :: ast_expression,\n ec_args :: list(ast_expression)\n )\n ; ast_bang_call(\n ebc_callee :: ast_expression,\n ebc_args :: list(ast_expression)\n ).\n\n:- type ast_pattern\n ---> p_constr(q_name, list(ast_pattern))\n ; p_number(int)\n ; p_wildcard\n ; p_var(string) % A declaration of a new variable\n ; p_symbol(q_name) % The binding of a new variable or a\n % constructor with zero args.\n ; p_list_nil\n ; p_list_cons(ast_pattern, ast_pattern).\n\n:- type ast_pragma\n ---> ast_pragma(\n astp_name :: string,\n astp_args :: list(ast_pragma_arg),\n astp_context :: context\n ).\n\n:- type ast_pragma_arg\n ---> ast_pragma_arg(string).\n\n%-----------------------------------------------------------------------%\n\n:- func type_arity(ast_type(T)) = arity.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n%-----------------------------------------------------------------------%\n\ntype_arity(ast_type(Params, _, _, _)) = arity(length(Params)).\ntype_arity(ast_type_abstract(Arity, _)) = Arity.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/build.m", "content": "%-----------------------------------------------------------------------%\n% Plasma builder\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This program starts the build process for Plasma projects\n%\n%-----------------------------------------------------------------------%\n:- module build.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module list.\n:- import_module string.\n\n:- import_module q_name.\n:- import_module util.\n:- import_module util.result.\n\n:- type plzbuild_options\n ---> plzbuild_options(\n pzb_targets :: list(nq_name),\n pzb_verbose :: verbose,\n pzb_rebuild :: rebuild,\n pzb_build_file :: string,\n pzb_build_dir :: string,\n pzb_report_timing :: report_timing,\n\n % Path to the plasma tools\n pzb_tools_path :: string,\n % Path to the source code\n pzb_source_path :: string\n ).\n\n:- type verbose\n ---> verbose\n ; terse.\n\n:- type rebuild\n ---> need_rebuild\n ; dont_rebuild.\n\n:- type report_timing\n ---> report_timing\n ; dont_report_timing.\n\n % build(Target, Verbose, Rebuild, !IO)\n %\n:- pred build(plzbuild_options::in, errors(string)::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module assoc_list.\n:- import_module bool.\n:- import_module cord.\n:- import_module float.\n:- import_module map.\n:- import_module maybe.\n:- import_module pair.\n:- import_module require.\n:- import_module set.\n:- import_module time.\n\n:- import_module toml.\n\n:- import_module constant.\n:- import_module context.\n:- import_module file_utils.\n:- import_module util.my_exception.\n:- import_module util.my_io.\n:- import_module util.mercury.\n:- import_module util.path.\n\n%-----------------------------------------------------------------------%\n\nbuild(Options, Result, !IO) :-\n BuildDir = Options ^ pzb_build_dir,\n % This code would make an interesting concurrency example. There's:\n % + Several calls to fsstat() and readdir() that can occur independent\n % of anything else.\n % + Reading the project file\n % + 2 independent computations (each is dependent on the project file's\n % contents), but may be skipped if files are up to date.\n % + mkdir and writing 3 files that depend on various other steps.\n\n % But ideally they're not broken down that finely as is common with\n % Promises, instead some of them may be threads because their control\n % flow makes sense that way.\n\n some [!Errors] (\n !:Errors = init,\n\n file_modification_time(Options ^ pzb_tools_path ++ \"/plzbuild\",\n PlzBuildMTime, !IO),\n\n read_project(Options ^ pzb_build_file, ProjRes, ProjFileMTime, !IO),\n ( ProjRes = ok(_)\n ; ProjRes = errors(ReadProjErrors),\n add_errors(ReadProjErrors, !Errors)\n ),\n\n ( ProjRes = ok(Proj),\n build_dependency_info(Proj, DepInfoRes, init, _, !IO),\n ( DepInfoRes = ok(DepInfo),\n\n setup_build_dir(Options, PlzBuildMTime, SetupDirRes, !IO),\n ( SetupDirRes = ok\n ; SetupDirRes = error(SetupDirError),\n add_error(context(Options ^ pzb_build_dir),\n SetupDirError, !Errors)\n ),\n\n % For now we have no detection of when the vars file\n % changes, we updated it every time.\n write_vars_file(Options, WriteVarsRes, !IO),\n ( WriteVarsRes = ok\n ; WriteVarsRes = error(WriteVarsError),\n add_error(\n context(BuildDir ++ \"/\" ++ ninja_vars_file),\n WriteVarsError, !Errors)\n ),\n\n ProjMTime = latest(ProjFileMTime, PlzBuildMTime),\n maybe_write_dependency_file(Options, ProjMTime, DepInfo,\n WriteDepsRes, !IO),\n ( WriteDepsRes = ok\n ; WriteDepsRes = error(WriteNinjaBuildError),\n add_error(context(BuildDir ++ \"/\" ++ ninja_build_file),\n WriteNinjaBuildError, !Errors)\n ),\n\n ImportWhitelist = compute_import_whitelist(Proj),\n maybe_write_import_whitelist(Options, ProjMTime,\n ImportWhitelist, WhitelistRes, !IO),\n ( WhitelistRes = ok\n ; WhitelistRes = error(WriteWhitelistError),\n add_error(nil_context, WriteWhitelistError, !Errors)\n ),\n\n ( if is_empty(!.Errors) then\n invoke_ninja(Options, Proj, Result0, !IO),\n ( Result0 = ok\n ; Result0 = error(Error),\n add_error(nil_context, Error, !Errors)\n )\n else\n true\n )\n ; DepInfoRes = errors(DepInfoErrors),\n add_errors(DepInfoErrors, !Errors)\n )\n ; ProjRes = errors(_)\n ),\n\n Result = !.Errors\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type target\n ---> target(\n % The base name for the file of the compiled code\n t_name :: nq_name,\n\n % The modules that make up the program\n t_modules :: list(q_name),\n t_modules_context :: context,\n t_pcflags :: maybe(string),\n t_c_sources :: list(string),\n t_c_sources_context :: context\n ).\n\n:- pred read_project(string::in, result(list(target), string)::out,\n time_t::out, io::di, io::uo) is det.\n\nread_project(BuildFile, Result, MTime, !IO) :-\n file_modification_time(BuildFile, MTime, !IO),\n io.open_input(BuildFile, OpenRes, !IO),\n ( OpenRes = ok(File),\n parse_toml(File, BuildFile, TOMLRes, !IO),\n close_input(File, !IO),\n ( TOMLRes = ok(TOML),\n Result0 = result_list_to_result(map(make_target(TOML), keys(TOML))),\n ( Result0 = ok(MaybeTargets),\n Result = ok(filter_map(func(yes(X)) = X is semidet,\n MaybeTargets))\n ; Result0 = errors(Errors),\n Result = errors(Errors)\n )\n ; TOMLRes = errors(Errors),\n Result = errors(Errors)\n )\n ; OpenRes = error(Error),\n Result = return_error(context(BuildFile), error_message(Error))\n ).\n\n:- func make_target(toml, string) = result(maybe(target), string).\n\nmake_target(TOML, TargetStr) = Result :-\n lookup(TOML, TargetStr, TargetVal - TargetContext),\n ( if\n TargetVal = tv_table(Target),\n search(Target, \"type\", tv_string(\"program\") - _)\n then\n TargetResult = nq_name_from_string(TargetStr),\n ( TargetResult = ok(TargetName),\n ModulesResult = search_toml_q_names(\n not_found_error(TargetContext, \"modules\"),\n Target, \"modules\"),\n CSourcesResult = search_toml_filenames(\n toml_search_default([], TargetContext),\n Target, \"c_sources\"),\n CompilerOptsResult = search_toml_maybe_string(Target, \"compiler_opts\"),\n (\n ModulesResult = ok(Modules - ModulesContext),\n CSourcesResult = ok(CSources - CSourcesContext),\n CompilerOptsResult = ok(CompilerOpts - _),\n\n ( if\n find_duplicates(Modules, DupModules),\n not is_empty(DupModules)\n then\n DupModulesStrings = map(func(M) =\n \"'\" ++ q_name_to_string(M) ++ \"'\",\n to_sorted_list(DupModules)),\n Result = return_error(TargetContext,\n format(\n \"The following modules were listed more than once: %s\",\n [s(string_join(\", \", DupModulesStrings))]))\n else\n Result = ok(yes(target(TargetName, Modules, ModulesContext,\n CompilerOpts, CSources, CSourcesContext)))\n )\n ;\n ModulesResult = ok(_),\n CSourcesResult = ok(_),\n CompilerOptsResult = errors(Errors),\n\n Result = errors(Errors)\n ;\n ModulesResult = ok(_),\n CSourcesResult = errors(Errors),\n\n Result = errors(Errors)\n ;\n ModulesResult = errors(Errors),\n\n Result = errors(Errors)\n )\n ; TargetResult = error(_),\n Result = return_error(TargetContext,\n format(\"Invalid name '%s'\", [s(TargetStr)]))\n )\n else\n Result = ok(no)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type search_result(T) == result(pair(T, context), string).\n\n % search_toml_q_names(NotFoundResult, WrapError, Toml, Key) = Result\n %\n % Search the toml for the given key, if not found return an error at\n % Context, if found try to parse it as a list of q_names. WrapError\n % lets the caller explain the context of the error.\n %\n:- func search_toml_q_names(search_result(list(q_name)), toml, toml_key) =\n search_result(list(q_name)).\n\nsearch_toml_q_names(NotFoundResult, TOML, Key) =\n search_toml_array(NotFoundResult, q_name_from_dotted_string,\n TOML, Key).\n\n % search_toml_q_names(NotFoundResult, WrapError, Toml, Key) = Result\n %\n:- func search_toml_filenames(search_result(list(string)), toml, toml_key) =\n search_result(list(string)).\n\nsearch_toml_filenames(NotFoundResult, TOML, Key) =\n search_toml_array(NotFoundResult, func(X) = ok(X), TOML, Key).\n\n:- func search_toml_array(search_result(list(T)),\n func(string) = maybe_error(T), toml, toml_key) =\n search_result(list(T)).\n\nsearch_toml_array(NotFoundResult, MakeResult, TOML, Key) =\n Result :-\n ( if search(TOML, Key, Value - Context) then\n ( if Value = tv_array(Values) then\n Result0 = result_list_to_result(map(\n (func(TV) = R :-\n ( if TV = tv_string(S) then\n R0 = MakeResult(S),\n ( R0 = ok(N),\n R = ok(N)\n ; R0 = error(Why),\n R = return_error(Context,\n field_error(Key,\n format(\"'%s' %s\", [s(S), s(Why)])))\n )\n else\n R = return_error(Context, \"Name in array is a string\")\n )\n ),\n Values)),\n ( Result0 = ok(List),\n Result = ok(List - Context)\n ; Result0 = errors(Errors),\n Result = errors(Errors)\n )\n else\n Result = return_error(Context,\n field_error(Key, \"Value is not an array\"))\n )\n else\n Result = NotFoundResult\n ).\n\n:- func search_toml_maybe_string(toml, toml_key) = search_result(maybe(string)).\n\nsearch_toml_maybe_string(TOML, Key) = Result :-\n ( if search(TOML, Key, Value - Context) then\n ( if Value = tv_string(String) then\n Result = ok(yes(String) - Context)\n else\n Result = return_error(Context,\n field_error(Key, \"Value is not a string\"))\n )\n else\n Result = ok(no - nil_context)\n ).\n\n:- func field_error(string, string) = string.\n\nfield_error(Field, Msg) = format(\"Invalid %s field: %s\", [s(Field), s(Msg)]).\n\n:- func not_found_error(context, toml_key) = search_result(T).\n\nnot_found_error(Context, Key) =\n return_error(Context, format(\"Key not found '%s'\", [s(Key)])).\n\n:- func toml_search_default(T, context) = search_result(T).\n\ntoml_search_default(X, C) = ok(X - C).\n\n%-----------------------------------------------------------------------%\n\n:- type dep_info == list(dep_target).\n\n:- type dep_target\n ---> dt_program(\n dtp_name :: nq_name,\n dtp_output :: string,\n dtp_inputs :: list(string)\n )\n ; dt_object(\n dto_name :: q_name,\n dto_output :: string,\n dto_input :: string,\n dto_depfile :: string,\n dto_flags :: string\n )\n ; dt_interface(\n dti_name :: q_name,\n dti_output :: string,\n dti_input :: string,\n dti_depfile :: string\n )\n ; dt_typeres(\n dttr_name :: q_name,\n dttr_output :: string,\n dttr_input :: string\n )\n ; dt_scan(\n dts_name :: q_name,\n dts_dep_file :: string,\n dts_source :: string,\n dts_interface :: string,\n dts_bytecode :: string\n )\n ; dt_foreign_hooks(\n dtcg_name :: q_name,\n dtcg_output_code :: string,\n dtcg_output_header :: string,\n dtcg_input :: string\n )\n % Generate an init file for the FFI from the info files.\n ; dt_gen_init(\n dtgi_name :: nq_name,\n dtgi_output :: string,\n dtgi_modules :: list(q_name)\n )\n ; dt_c_link(\n dtcl_name :: nq_name,\n dtcl_output :: string,\n dtcl_input :: list(string)\n )\n ; dt_c_compile(\n dtcc_output :: string,\n dtcc_input :: string,\n dtcc_headers :: list(string),\n dtcc_generated :: generated\n ).\n\n:- type generated\n ---> was_generated\n ; hand_written.\n\n:- pred build_dependency_info(list(target)::in,\n result(dep_info, string)::out, dir_info::in, dir_info::out,\n io::di, io::uo) is det.\n\nbuild_dependency_info(Targets, MaybeDeps, !DirInfo, !IO) :-\n MaybeModules0 = make_module_info(Targets),\n ( MaybeModules0 = ok(Modules0),\n % The term Target is overloaded here, it means both the whole things\n % that plzbuild is trying to build, but also the steps that ninja does\n % to build them.\n map_foldl2(find_module_file, Modules0, MaybeModules1, !DirInfo, !IO),\n MaybeModules = result_list_to_result(MaybeModules1),\n find_foreign_sources(Targets, MaybeForeignSources, !DirInfo, !IO),\n\n ( MaybeModules = ok(Modules),\n MaybeForeignSources = ok(ForeignSources0),\n ForeignSources = sort_and_remove_dups(ForeignSources0),\n ModuleTargets = map(make_module_targets, Modules),\n ProgramTargets = map(make_program_target, Targets),\n ForeignLinkTargetsRes = result_list_to_result(\n map(make_foreign_link_targets, Targets)),\n\n ( ForeignLinkTargetsRes = ok(ForeignLinkTargets0),\n ForeignCompileTargets = map(make_foreign_target,\n ForeignSources),\n ForeignLinkTargets = condense(ForeignLinkTargets0),\n MaybeDeps = ok(condense(ModuleTargets) ++\n ForeignCompileTargets ++\n ForeignLinkTargets ++ ProgramTargets)\n ; ForeignLinkTargetsRes = errors(Errors),\n MaybeDeps = errors(Errors)\n )\n ; MaybeModules = ok(_),\n MaybeForeignSources = errors(Errors),\n MaybeDeps = errors(Errors)\n ; MaybeModules = errors(Errors),\n MaybeForeignSources = ok(_),\n MaybeDeps = errors(Errors)\n ; MaybeModules = errors(ErrorsA),\n MaybeForeignSources = errors(ErrorsB),\n MaybeDeps = errors(ErrorsA ++ ErrorsB)\n )\n ; MaybeModules0 = errors(Errors),\n MaybeDeps = errors(Errors)\n ).\n\n:- type module_info\n ---> module_info(\n mi_name :: q_name,\n mi_context :: context,\n mi_file :: string,\n mi_pcflags :: string\n ).\n\n:- func make_module_info(list(target)) = result(list(module_info), string).\n\nmake_module_info(Targets) = Modules :-\n Modules0 = condense(map(target_get_modules, Targets)),\n foldl_result(resolve_duplicate_modules, Modules0, init, MaybeModules1),\n ( MaybeModules1 = ok(Modules1),\n Modules = ok(map.values(Modules1))\n ; MaybeModules1 = errors(Error),\n Modules = errors(Error)\n ).\n\n:- func target_get_modules(target) = list(module_info).\n\ntarget_get_modules(Target) = Modules :-\n Context = Target ^ t_modules_context,\n PCFlags = maybe_default(\"\", Target ^ t_pcflags),\n Modules = map(func(N) = module_info(N, Context, \"\", PCFlags),\n Target ^ t_modules).\n\n:- pred resolve_duplicate_modules(module_info::in,\n map(q_name, module_info)::in,\n result(map(q_name, module_info), string)::out) is det.\n\nresolve_duplicate_modules(Module, !Map) :-\n Name = Module ^ mi_name,\n map_set_or_update_result(func(M) = module_merge(M, Module),\n Name, Module, !Map).\n\n:- func module_merge(module_info, module_info) = result(module_info, string).\n\nmodule_merge(Ma, Mb) =\n ( if Ma ^ mi_pcflags = Mb ^ mi_pcflags then\n ok(module_info(Ma ^ mi_name,\n context_earliest(Ma ^ mi_context, Mb ^ mi_context),\n Ma ^ mi_file,\n Ma ^ mi_pcflags))\n else\n return_error(context_earliest(Ma ^ mi_context, Mb ^ mi_context),\n \"Flags set for the same module in different programs do not match\")\n ).\n\n:- pred find_module_file(module_info::in,\n result(module_info, string)::out,\n dir_info::in, dir_info::out, io::di, io::uo) is det.\n\nfind_module_file(Module, ModuleResult, !DirInfo, !IO) :-\n find_module_file(\".\", source_extension, Module ^ mi_name, FileRes,\n !DirInfo, !IO),\n ( FileRes = yes(File),\n ModuleResult = ok(Module ^ mi_file := File)\n ; FileRes = no,\n ModuleResult = return_error(Module ^ mi_context,\n format(\"Can't find source for %s module\",\n [s(q_name_to_string(Module ^ mi_name))]))\n ; FileRes = error(Path, Message),\n ModuleResult = return_error(context(Path), Message)\n ).\n\n:- pred find_foreign_sources(list(target)::in,\n result(list(string), string)::out,\n dir_info::in, dir_info::out, io::di, io::uo) is det.\n\nfind_foreign_sources(Targets, Result, !DirInfo, !IO) :-\n SourcesList = condense(map((func(T) = T ^ t_c_sources), Targets)),\n % We don't do any filesystem checking, but might in the future.\n Result = ok(SourcesList).\n\n:- func make_program_target(target) = dep_target.\n\nmake_program_target(Target) = DepTarget :-\n FileName = nq_name_to_string(Target ^ t_name) ++ library_extension,\n ObjectNames = map(func(M) = canonical_base_name(M) ++ output_extension,\n Target ^ t_modules),\n DepTarget = dt_program(Target ^ t_name, FileName, ObjectNames).\n\n:- func make_module_targets(module_info) = list(dep_target).\n\nmake_module_targets(ModuleInfo) = Targets :-\n module_info(ModuleName, _, SourceName, PCFlags) = ModuleInfo,\n BaseName = canonical_base_name(ModuleName),\n TyperesName = BaseName ++ typeres_extension,\n InterfaceName = BaseName ++ interface_extension,\n ObjectName = BaseName ++ output_extension,\n DepFile = BaseName ++ depends_extension,\n Targets = [\n dt_scan(ModuleName, DepFile, SourceName, InterfaceName, ObjectName),\n dt_interface(ModuleName, InterfaceName, SourceName, DepFile),\n dt_object(ModuleName, ObjectName, SourceName, DepFile, PCFlags),\n dt_typeres(ModuleName, TyperesName, SourceName),\n dt_foreign_hooks(ModuleName,\n module_to_foreign_hooks_code(ModuleName),\n module_to_foreign_hooks_header(ModuleName), SourceName),\n dt_c_compile(\n module_to_foreign_object(ModuleName),\n module_to_foreign_hooks_code(ModuleName),\n [module_to_foreign_hooks_header(ModuleName)],\n was_generated)\n ].\n\n:- func make_foreign_link_targets(target) =\n result(list(dep_target), string).\n\nmake_foreign_link_targets(Target) = DepsResult :-\n ForeignSources = Target ^ t_c_sources,\n Modules = Target ^ t_modules,\n ( ForeignSources = [],\n DepsResult = ok([])\n ; ForeignSources = [_ | _],\n Output = make_c_library_name(Target),\n map((pred(In::in, Out::out) is det :-\n ( if\n file_change_extension(cpp_extension,\n native_object_extension, In, Out0)\n then\n Out = ok(Out0)\n else\n Out = error(In)\n )\n ),\n ForeignSources, ForeignObjectsResults),\n ForeignObjectsResult = maybe_error_list(ForeignObjectsResults),\n ( ForeignObjectsResult = ok(ForeignObjects),\n ModuleForeignObjects = map(module_to_foreign_object, Modules),\n InitBaseName = nq_name_to_string(Target ^ t_name) ++ \"_init\",\n InitSourceName = InitBaseName ++ cpp_extension,\n InitObjectName = InitBaseName ++ native_object_extension,\n InitTargetSource = dt_gen_init(Target ^ t_name, InitSourceName,\n Modules),\n InitTargetObject = dt_c_compile(InitObjectName, InitSourceName,\n map(module_to_foreign_hooks_header, Modules), was_generated),\n LinkTarget = dt_c_link(Target ^ t_name, Output,\n ForeignObjects ++\n ModuleForeignObjects ++\n [InitObjectName]),\n DepsResult =\n ok([InitTargetSource, InitTargetObject, LinkTarget])\n ; ForeignObjectsResult = error(Errors),\n DepsResult = return_error(\n Target ^ t_c_sources_context,\n format(\"Unrecognised extensions on these files: %s\",\n [s(join_list(\", \", Errors))]))\n )\n ).\n\n:- func make_c_library_name(target) = string.\n\nmake_c_library_name(Target) = nq_name_to_string(Target ^ t_name) ++\n native_dylib_extension.\n\n:- func make_foreign_target(string) = dep_target.\n\nmake_foreign_target(CFileName) = Target :-\n ( if\n file_change_extension(cpp_extension, native_object_extension,\n CFileName, ObjectName)\n then\n Target = dt_c_compile(ObjectName, CFileName, [], hand_written)\n else\n compile_error($file, $pred, \"Unrecognised source file extension\")\n ).\n\n:- func module_to_foreign_hooks_code(q_name) = string.\n\nmodule_to_foreign_hooks_code(Module) =\n module_to_foreign_hooks_base(Module) ++ cpp_extension.\n\n:- func module_to_foreign_hooks_header(q_name) = string.\n\nmodule_to_foreign_hooks_header(Module) =\n module_to_foreign_hooks_base(Module) ++ c_header_extension.\n\n:- func module_to_foreign_hooks_base(q_name) = string.\n\nmodule_to_foreign_hooks_base(Module) =\n canonical_base_name(Module) ++ \"_f\".\n\n:- func module_to_foreign_object(q_name) = string.\n\nmodule_to_foreign_object(Module) =\n canonical_base_name(Module) ++ \"_f\" ++ native_object_extension.\n\n%-----------------------------------------------------------------------%\n\n % Write the dependency file if it the build file is newer.\n %\n:- pred maybe_write_dependency_file(plzbuild_options::in, time_t::in,\n dep_info::in, maybe_error::out, io::di, io::uo) is det.\n\nmaybe_write_dependency_file(Options, ProjMTime, DepInfo, Result, !IO) :-\n update_if_stale(Options ^ pzb_verbose, ProjMTime,\n Options ^ pzb_build_dir ++ \"/\" ++ ninja_build_file,\n write_dependency_file(Options, DepInfo), Result, !IO).\n\n:- pred write_dependency_file(plzbuild_options::in, dep_info::in,\n maybe_error::out, io::di, io::uo) is det.\n\nwrite_dependency_file(Options, DepInfo, Result, !IO) :-\n write_file(Options ^ pzb_verbose,\n Options ^ pzb_build_dir ++ \"/\" ++ ninja_build_file,\n do_write_dependency_file(DepInfo), Result, !IO).\n\n:- pred do_write_dependency_file(dep_info::in, output_stream::in,\n io::di, io::uo) is det.\n\ndo_write_dependency_file(DepInfo, BuildFile, !IO) :-\n write_string(BuildFile, \"# Auto-generated by plzbuild\\n\", !IO),\n format(BuildFile, \"include %s\\n\", [s(ninja_rules_file)], !IO),\n format(BuildFile, \"include %s\\n\\n\", [s(ninja_vars_file)], !IO),\n foldl(write_target(BuildFile), DepInfo, !IO).\n\n:- pred write_statement(output_stream::in,\n string::in, string::in, string::in, list(string)::in, list(string)::in, maybe(string)::in,\n list(string)::in, maybe(string)::in, list(pair(string, string))::in, io::di, io::uo) is det.\n\nwrite_statement(File, Command, Name, Output, ImplicitOutputs, Inputs, MaybeBinary,\n ImplicitDeps, MaybeDynDep, Vars, !IO) :-\n ( ImplicitOutputs = [],\n ImplicitOutput = \"\"\n ; ImplicitOutputs = [_ | _],\n ImplicitOutput = \" | \" ++ string_join(\" \", ImplicitOutputs)\n ),\n InputsStr = string_join(\" \", Inputs),\n ( MaybeBinary = yes(Binary),\n BinaryInput = [\"$path/\" ++ Binary]\n ; MaybeBinary = no,\n BinaryInput = []\n ),\n ExtraDeps = BinaryInput ++ ImplicitDeps,\n ( ExtraDeps = [_ | _],\n ExtraDepsStr = \" | \" ++ string_join(\" \", ExtraDeps)\n ; ExtraDeps = [],\n ExtraDepsStr = \"\"\n ),\n ( MaybeDynDep = yes(DynDep),\n DynDepStr = \" || \" ++ DynDep\n ; MaybeDynDep = no,\n DynDepStr = \"\"\n ),\n write_string(File,\n \"build \" ++ Output ++ ImplicitOutput ++ \" : \" ++ Command ++ \" \" ++\n InputsStr ++ ExtraDepsStr ++ DynDepStr ++ \"\\n\",\n !IO),\n write_var(File, \"name\" - Name, !IO),\n ( MaybeDynDep = yes(DynDep_),\n write_var(File, \"dyndep\" - DynDep_, !IO)\n ; MaybeDynDep = no\n ),\n foldl(write_var(File), Vars, !IO),\n nl(File, !IO).\n\n:- pred write_var(output_stream::in, pair(string, string)::in,\n io::di, io::uo) is det.\n\nwrite_var(File, Var - Val, !IO) :-\n format(File, \" %s = %s\\n\", [s(Var), s(Val)], !IO).\n\n:- pred write_build_statement(output_stream::in, string::in, string::in,\n string::in, string::in, string::in, maybe(string)::in, io::di, io::uo)\n is det.\n\nwrite_build_statement(File, Command, Name, Output, Path, Input, MaybeBinary,\n !IO) :-\n write_statement(File, Command, Name, Output, [], [Path ++ Input],\n MaybeBinary, [], no, [], !IO).\n\n:- pred write_c_compile_statement(output_stream::in, string::in,\n string::in, string::in, string::in, list(string)::in,\n io::di, io::uo) is det.\n\nwrite_c_compile_statement(File, Name, Output, Path, Input, Headers,\n !IO) :-\n write_statement(File, \"c_compile\", Name, Output, [], [Path ++ Input],\n no, Headers, no, [], !IO).\n\n:- pred write_plzc_statement(output_stream::in, string::in, q_name::in,\n string::in, string::in, string::in, list(pair(string, string))::in,\n io::di, io::uo) is det.\n\nwrite_plzc_statement(File, Command, Name, Output, Input,\n DepFile, Vars, !IO) :-\n write_statement(File, Command, q_name_to_string(Name),\n Output, [], [\"../\" ++ Input], yes(\"plzc\"), [], yes(DepFile), Vars, !IO).\n\n:- pred write_link_statement(output_stream::in, string::in, nq_name::in,\n string::in, list(string)::in, maybe(string)::in,\n io::di, io::uo) is det.\n\nwrite_link_statement(File, Command, Name, Output, Objects, MaybeBinary,\n !IO) :-\n write_statement(File, Command, nq_name_to_string(Name),\n \"../\" ++ Output, [], Objects, MaybeBinary, [], no, [], !IO).\n\n:- pred write_target(output_stream::in, dep_target::in, io::di, io::uo) is det.\n\nwrite_target(File, dt_program(ProgName, ProgFile, Objects), !IO) :-\n write_link_statement(File, \"plzlink\", ProgName, ProgFile, Objects,\n yes(\"plzlnk\"), !IO).\nwrite_target(File,\n dt_object(ModuleName, ObjectFile, SourceFile, DepFile, Flags),\n !IO) :-\n % If we can detect import errors when building dependencies we can\n % remove it from this step and avoid some extra rebuilds.\n ImportWhitelistVar = \"import_whitelist\" -\n import_whitelist_file_no_directroy,\n PCFlagsVar = \"pcflags_file\" - Flags,\n write_plzc_statement(File, \"plzc\", ModuleName, ObjectFile, SourceFile,\n DepFile, [ImportWhitelistVar, PCFlagsVar], !IO).\nwrite_target(File,\n dt_interface(ModuleName, InterfaceFile, SourceFile, DepFile), !IO) :-\n write_plzc_statement(File, \"plzi\", ModuleName, InterfaceFile,\n SourceFile, DepFile, [], !IO).\nwrite_target(File,\n dt_typeres(ModuleName, TyperesFile, SourceFile), !IO) :-\n write_build_statement(File, \"plztyperes\", q_name_to_string(ModuleName),\n TyperesFile, \"../\", SourceFile, yes(\"plzc\"), !IO).\nwrite_target(File,\n dt_scan(ModuleName, DepFile, SourceFile, InterfaceFile, BytecodeFile),\n !IO) :-\n Inputs = [\"../\" ++ SourceFile],\n write_statement(File, \"plzscan\", q_name_to_string(ModuleName),\n DepFile, [], Inputs, yes(\"plzc\"), [], no,\n [\"target\" - BytecodeFile,\n \"interface\" - InterfaceFile],\n !IO).\nwrite_target(File, dt_foreign_hooks(ModuleName, OutCode, OutHeader, Source),\n !IO) :-\n write_statement(File, \"plzgf\", q_name_to_string(ModuleName),\n OutCode, [OutHeader], [\"../\" ++ Source], no, [], no,\n [\"header\" - OutHeader], !IO).\nwrite_target(File, dt_gen_init(ModuleName, Output, Inputs), !IO) :-\n InputsString = string_join(\" \", map(q_name_to_string, Inputs)),\n write_statement(File, \"gen_init\", nq_name_to_string(ModuleName),\n Output, [], [], yes(\"plzgeninit\"), [], no,\n [\"modules\" - InputsString], !IO).\nwrite_target(File, dt_c_link(ModuleName, Output, Inputs), !IO) :-\n write_link_statement(File, \"c_link\", ModuleName, Output, Inputs,\n no, !IO).\nwrite_target(File, dt_c_compile(Object, Source, Headers, SrcWasGenerated),\n !IO) :-\n ( SrcWasGenerated = was_generated,\n Path = \"\"\n ; SrcWasGenerated = hand_written,\n Path = \"../\"\n ),\n write_c_compile_statement(File, Source, Object, Path, Source, Headers, !IO).\n\n%-----------------------------------------------------------------------%\n\n:- pred write_vars_file(plzbuild_options::in, maybe_error::out,\n io::di, io::uo) is det.\n\nwrite_vars_file(Options, Result, !IO) :-\n write_file(Options ^ pzb_verbose,\n Options ^ pzb_build_dir ++ \"/\" ++ ninja_vars_file,\n do_write_vars_file(Options), Result, !IO).\n\n:- pred do_write_vars_file(plzbuild_options::in, output_stream::in,\n io::di, io::uo) is det.\n\ndo_write_vars_file(Options, File, !IO) :-\n Path0 = Options ^ pzb_tools_path,\n ( if is_relative(Path0) then\n Path = \"../\" ++ Path0\n else\n Path = Path0\n ),\n\n ReportTiming = Options ^ pzb_report_timing,\n ( ReportTiming = report_timing,\n PCFlags = \"--report-timing\"\n ; ReportTiming = dont_report_timing,\n PCFlags = \"\"\n ),\n % All options are the same for now.\n PLFlags = PCFlags,\n\n write_string(File, \"# Auto-generated by plzbuild\\n\", !IO),\n format(File, \"path = %s\\n\", [s(Path)], !IO),\n format(File, \"source_path = %s\\n\\n\", [s(Options ^ pzb_source_path)], !IO),\n format(File, \"pcflags_global = %s\\n\", [s(PCFlags)], !IO),\n format(File, \"plflags_global = %s\\n\", [s(PLFlags)], !IO),\n format(File, \"cxx = c++ -fpic\\n\", [], !IO),\n format(File, \"cc = cc -fpic -shared\\n\", [], !IO).\n\n%-----------------------------------------------------------------------%\n\n%\n% Use a whitelist to inform the compiler which modules may import which\n% other modules based on the module lists in the project file.\n%\n\n % Rather than actually compute the whitelist and store it, which could\n % be large, store the information used to compute it. The set of sets\n % of modules that may import each-other.\n %\n:- type whitelist == set(set(q_name)).\n\n:- func compute_import_whitelist(list(target)) = whitelist.\n\ncompute_import_whitelist(Proj) =\n list_to_set(map(func(T) = list_to_set(T ^ t_modules), Proj)).\n\n:- pred maybe_write_import_whitelist(plzbuild_options::in, time_t::in,\n whitelist::in, maybe_error::out, io::di, io::uo) is det.\n\nmaybe_write_import_whitelist(Options, ProjMTime, DepInfo, Result, !IO) :-\n update_if_stale(Options ^ pzb_verbose, ProjMTime,\n Options ^ pzb_build_dir ++ \"/\" ++ import_whitelist_file_no_directroy,\n write_import_whitelist(Options, DepInfo), Result, !IO).\n\n:- pred write_import_whitelist(plzbuild_options::in, whitelist::in,\n maybe_error::out, io::di, io::uo) is det.\n\nwrite_import_whitelist(Options, Whitelist, Result, !IO) :-\n write_file(Options ^ pzb_verbose,\n Options ^ pzb_build_dir ++ \"/\" ++ import_whitelist_file_no_directroy,\n do_write_import_whitelist(Whitelist), Result, !IO).\n\n:- pred do_write_import_whitelist(whitelist::in, text_output_stream::in,\n io::di, io::uo) is det.\n\ndo_write_import_whitelist(Whitelist, File, !IO) :-\n write(File, map(to_sorted_list, to_sorted_list(Whitelist)) `with_type`\n list(list(q_name)), !IO),\n write_string(File, \".\\n\", !IO).\n\n%-----------------------------------------------------------------------%\n\n:- pred ensure_ninja_rules_file(plzbuild_options::in, time_t::in,\n maybe_error::out, io::di, io::uo) is det.\n\nensure_ninja_rules_file(Options, MTime, Result, !IO) :-\n Rebuild = Options ^ pzb_rebuild,\n ( Rebuild = need_rebuild,\n write_ninja_rules_file(Options, Result, !IO)\n ; Rebuild = dont_rebuild,\n update_if_stale(Options ^ pzb_verbose, MTime,\n Options ^ pzb_build_dir ++ \"/\" ++ ninja_rules_file,\n write_ninja_rules_file(Options), Result, !IO)\n ).\n\n:- pred write_ninja_rules_file(plzbuild_options::in, maybe_error::out,\n io::di, io::uo) is det.\n\nwrite_ninja_rules_file(Options, Result, !IO) :-\n write_file(Options ^ pzb_verbose,\n Options ^ pzb_build_dir ++ \"/\" ++ ninja_rules_file,\n (pred(File::in, IO0::di, IO::uo) is det :-\n write_string(File, rules_contents, IO0, IO)\n ),\n Result, !IO).\n\n:- func rules_contents = string.\n\nrules_contents =\n\"# Auto-generated by plzbuild\nninja_required_version = 1.10\n\nrule plztyperes\n command = $path/plzc $pcflags_global $pcflags_file $\n --mode make-typeres-exports $\n --module-name-check $name $\n --source-path $source_path $\n $in -o $out\n description = Calculating type & resource exports for $name\n\nrule plzi\n command = $path/plzc $pcflags_global $pcflags_file $\n --mode make-interface $\n --module-name-check $name $\n --source-path $source_path $\n $in -o $out\n description = Making interface for $name\n\nrule plzscan\n command = $path/plzc $pcflags_global $pcflags_file $\n --mode scan $\n --target-bytecode $target --target-interface $interface $\n --module-name-check $name $\n --source-path $source_path $\n $in -o $out\n description = Scanning $name for dependencies\n\nrule plzc\n command = $path/plzc $pcflags_global $pcflags_file $\n --mode compile $\n --import-whitelist $import_whitelist $\n --module-name-check $name $\n --source-path $source_path $\n $in -o $out\n description = Compiling $name\n\nrule plzgf\n command = $path/plzc $pcflags_global $pcflags_file $\n --mode generate-foreign $\n --module-name-check $name $\n --source-path $source_path $\n --output-header $header $\n $in -o $out\n description = Generating foreign hooks for $name\n\nrule gen_init\n command = $path/plzgeninit $\n $modules -o $out\n description = Generating foreign initialisation code for $name\n\nrule plzlink\n command = $path/plzlnk $plflags_global -n $name -o $out $in\n description = Linking $name\n\nrule c_link\n command = $cc -o $out $in\n description = Linking foreign code for $name\n\nrule c_compile\n command = $cxx -o $out -c $in\n description = Compiling $name\n\".\n\n%-----------------------------------------------------------------------%\n\n:- pred invoke_ninja(plzbuild_options::in, list(target)::in,\n maybe_error::out, io::di, io::uo) is det.\n\ninvoke_ninja(Options, Proj, Result, !IO) :-\n Verbose = Options ^ pzb_verbose,\n Targets0 = Options ^ pzb_targets,\n ( Targets0 = [_ | _],\n TargetSet = list_to_set(Targets0),\n Targets = filter(pred(T::in) is semidet :-\n member(T ^ t_name, TargetSet), Proj)\n ; Targets0 = [],\n Targets = Proj\n ),\n NinjaTargets = map(\n (func(T) = [PZTarget] ++ CTarget :-\n Name = T ^ t_name,\n PZTarget = ninja_target_path(Name, library_extension),\n CSources = T ^ t_c_sources,\n ( CSources = [],\n CTarget = []\n ; CSources = [_ | _],\n % Need to build the foreign code\n CTarget = [ninja_target_path(Name, native_dylib_extension)]\n )\n ), Targets),\n NinjaTargetsStr = string_join(\" \", condense(NinjaTargets)),\n invoke_command(Verbose, format(\"ninja %s -C %s %s\",\n [s(verbose_opt_str(Verbose)), s(Options ^ pzb_build_dir),\n s(NinjaTargetsStr)]),\n Result, !IO).\n\n:- func ninja_target_path(nq_name, string) = string.\n\nninja_target_path(Name, Extension) =\n \"../\" ++ nq_name_to_string(Name) ++ Extension.\n\n:- pred clean(plzbuild_options::in, io::di, io::uo) is det.\n\nclean(Options, !IO) :-\n Verbose = Options ^ pzb_verbose,\n BuildDir = Options ^ pzb_build_dir,\n ( Verbose = verbose,\n format(\"Removing build directory %s\\n\",\n [s(BuildDir)], !IO)\n ; Verbose = terse\n ),\n remove_file_recursively(BuildDir, Result, !IO),\n ( Result = ok\n ; Result = error(Error),\n format(\"%s: %s\",\n [s(BuildDir), s(error_message(Error))], !IO)\n ).\n\n:- func verbose_opt_str(verbose) = string.\n\nverbose_opt_str(terse) = \"\".\nverbose_opt_str(verbose) = \"-v\".\n\n:- pred invoke_command(verbose::in, string::in, maybe_error::out,\n io::di, io::uo) is det.\n\ninvoke_command(Verbose, Command, Result, !IO) :-\n ( Verbose = verbose,\n format(stderr_stream, \"Invoking: %s\\n\", [s(Command)], !IO),\n write_string(stderr_stream, \"-----\\n\", !IO)\n ; Verbose = terse\n ),\n call_system(Command, SysResult, !IO),\n ( Verbose = verbose,\n write_string(stderr_stream, \"-----\\n\", !IO)\n ; Verbose = terse\n ),\n ( SysResult = ok(Status),\n ( if Status = 0 then\n Result = ok\n else\n Result = error(format(\"Sub-command '%s' exited with exit-status %d\",\n [s(Command), i(Status)]))\n )\n ; SysResult = error(Error),\n Result = error(format(\"Could not execute sub-command '%s': %s\",\n [s(Command), s(error_message(Error))]))\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred setup_build_dir(plzbuild_options::in, time_t::in, maybe_error::out,\n io::di, io::uo) is det.\n\nsetup_build_dir(Options, MTime, Result, !IO) :-\n ensure_directory(Options, Result0, FreshBuildDir, !IO),\n ( Result0 = ok,\n ( FreshBuildDir = fresh,\n % We know that we ust mkdir'd the build directory, so we can\n % skip a stat() call.\n write_ninja_rules_file(Options, Result, !IO)\n ; FreshBuildDir = stale,\n ensure_ninja_rules_file(Options, MTime, Result, !IO)\n )\n ; Result0 = error(_),\n Result = Result0\n ).\n\n:- type fresh\n ---> fresh\n ; stale.\n\n:- pred ensure_directory(plzbuild_options::in, maybe_error::out,\n fresh::out, io::di, io::uo) is det.\n\nensure_directory(Options, Result, Fresh, !IO) :-\n Rebuild = Options ^ pzb_rebuild,\n BuildDir = Options ^ pzb_build_dir,\n file_type(yes, BuildDir, StatResult, !IO),\n ( StatResult = ok(Stat),\n ( Stat = directory,\n ( Rebuild = need_rebuild,\n clean(Options, !IO),\n mkdir_build_directory(Options, Result, !IO),\n Fresh = fresh\n ; Rebuild = dont_rebuild,\n Result = ok,\n Fresh = stale\n )\n ;\n ( Stat = regular_file\n ; Stat = symbolic_link\n ; Stat = named_pipe\n ; Stat = socket\n ; Stat = character_device\n ; Stat = block_device\n ; Stat = message_queue\n ; Stat = semaphore\n ; Stat = shared_memory\n ; Stat = unknown\n ),\n ( Rebuild = need_rebuild,\n clean(Options, !IO),\n mkdir_build_directory(Options, Result, !IO),\n Fresh = fresh\n ; Rebuild = dont_rebuild,\n Result = error(format(\n \"Cannot create build directory, \" ++\n \"'%s' already exists as non-directory\",\n [s(BuildDir)])),\n Fresh = stale\n )\n )\n ; StatResult = error(_),\n mkdir_build_directory(Options, Result, !IO),\n Fresh = fresh\n ).\n\n:- pred mkdir_build_directory(plzbuild_options::in, maybe_error::out,\n io::di, io::uo) is det.\n\nmkdir_build_directory(Options, Result, !IO) :-\n Verbose = Options ^ pzb_verbose,\n BuildDir = Options ^ pzb_build_dir,\n ( Verbose = verbose,\n format(stderr_stream, \"mkdir %s\\n\", [s(BuildDir)], !IO)\n ; Verbose = terse\n ),\n mkdir(BuildDir, MkdirResult, Error, !IO),\n ( MkdirResult = yes,\n Result = ok\n ; MkdirResult = no,\n Result = error(\n format(\"Cannot create build directory '%s': %s\",\n [s(BuildDir), s(Error)]))\n ).\n\n:- pragma foreign_decl(\"C\", local,\n\"\n#include \n\").\n\n:- pred mkdir(string::in, bool::out, string::out, io::di, io::uo) is det.\n\n:- pragma foreign_proc(\"C\",\n mkdir(Name::in, Result::out, Error::out, _IO0::di, _IO::uo),\n [promise_pure, will_not_call_mercury, will_not_throw_exception],\n \"\n int ret = mkdir(Name, 0755);\n if (ret == 0) {\n Result = MR_YES;\n // Error really is const\n Error = (char *)\"\"\"\";\n } else {\n Result = MR_NO;\n char *error_msg = MR_GC_NEW_ARRAY(char, 128);\n ret = strerror_r(errno, error_msg, 128);\n if (ret == 0) {\n Error = error_msg;\n } else {\n Error = (char *)\"\"Buffer too small for error message\"\";\n }\n }\n \").\n\n%-----------------------------------------------------------------------%\n\n:- pred update_if_stale(verbose, time_t, string,\n pred(maybe_error, io, io), maybe_error, io, io).\n:- mode update_if_stale(in, in, in,\n pred(out, di, uo) is det, out, di, uo).\n\nupdate_if_stale(Verbose, ProjMTime, File, Update, Result, !IO) :-\n io.file_modification_time(File, MTimeResult, !IO),\n ( MTimeResult = ok(MTime),\n ( if difftime(ProjMTime, MTime) > 0.0 then\n % Project file is newer.\n Update(Result, !IO)\n else\n ( Verbose = verbose,\n format(stderr_stream,\n \"Not writing %s, it is already current\\n\",\n [s(File)], !IO)\n ; Verbose = terse\n ),\n Result = ok\n )\n ; MTimeResult = error(_),\n % Always write the file.\n Update(Result, !IO)\n ).\n\n:- func latest(time_t, time_t) = time_t.\n\nlatest(A, B) =\n ( if difftime(A, B) > 0.0 then\n A\n else\n B\n ).\n\n % Get a file modification time or now if unknown.\n %\n:- pred file_modification_time(string::in, time_t::out, io::di, io::uo) is\n det.\n\nfile_modification_time(File, MTime, !IO) :-\n io.file_modification_time(File, TimeRes, !IO),\n ( TimeRes = ok(MTime)\n ; TimeRes = error(_),\n % Assume the file was modified now, causing other files to be\n % updated.\n time(MTime, !IO)\n ).\n\n:- pred write_file(verbose, string,\n pred(text_output_stream, io, io), maybe_error, io, io).\n:- mode write_file(in, in,\n pred(in, di, uo) is det, out, di, uo) is det.\n\nwrite_file(Verbose, Filename, Writer, Result, !IO) :-\n ( Verbose = verbose,\n format(stderr_stream, \"Writing %s\\n\", [s(Filename)], !IO)\n ; Verbose = terse\n ),\n io.open_output(Filename, FileResult, !IO),\n ( FileResult = ok(File),\n Writer(File, !IO),\n close_output(File, !IO),\n Result = ok\n ; FileResult = error(Error),\n Result = error(\n format(\"Cannot write '%s': %s\",\n [s(Filename), s(error_message(Error))]))\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/builtins.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module builtins.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Plasma builtins.\n%\n% Builtins belong in the builtin module which is implicitly imported, both\n% with and without the \"builtin\" qualifier during compilation of any module.\n% Builtins may include functions, types and their constructors, interfaces\n% and interface implementations.\n%\n% There are two main types of builtin function, with sub-types:\n%\n% + Non-foreign\n% + Foreign\n%\n% Non-foreign\n% ===========\n%\n% Non-foreign builtins are completely handled by the compiler, by the time\n% the runtime is involved they look like regular Plasma code.\n%\n% Core builtins (bit_core)\n% ------------------------\n%\n% Any procedure that could be written in Plasma, but it instead provided by\n% the compiler and compiled (from Core representation, hence the name) with\n% the program. bool_to_string is an example, these builtins have their core\n% definitions in this module.\n%\n% PZ inline builtins (bit_inline_pz)\n% ----------------------------------\n%\n% This covers arithmetic operators and other small \"functions\" that are\n% equivalent to one or maybe 2-3 PZ instructions. core_to_pz will convert\n% calls to these functions into their native PZ bytecodes. It also\n% generates function bodies for these so higher-order references can call to\n% them.\n%\n% Foreign\n% =======\n%\n% The compiler passes calls to foreign builtins through to the runtime where\n% they look like references to the imported Builtin module. pz_builtin.cpp\n% decides how each foreign builtin is implemented. So these are all bit_rts\n% builtins.\n%\n% Runtime inline\n% --------------\n%\n% These builtins are stored as a sequence of PZ instructions within the\n% runtime, they're executed just like normal procedures, their definitions\n% are simply provided by the runtime rather than a .pz file.\n%\n% PZ builtins\n% -----------\n%\n% Just like runtime inline builtins, these are a series of PZ instructions.\n% The difference is they arn't callable by the programmer, usually being\n% responsible for data tagging.\n%\n% Foreign builtins\n% ----------------\n%\n% These mostly cover operating system services. They are implemented in\n% pz_run_*.c and are transformed when the program is read into an opcode\n% that will cause the C procedure built into the RTS to be executed. The\n% specifics depend on which pz_run_*.c file is used.\n%\n% They are very similar to foreign code generally, but marked as an import\n% rather than foreign in the PZ bytecode files since they have a different\n% module name.\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module map.\n\n:- import_module common_types.\n:- import_module core.\n:- import_module core.types.\n:- import_module pre.\n:- import_module pre.env.\n:- import_module pz.\n:- import_module pz.pz_ds.\n:- import_module q_name.\n\n:- type builtin_item\n ---> bi_func(func_id)\n ; bi_ctor(ctor_id)\n ; bi_resource(resource_id)\n ; bi_type(type_id, arity)\n ; bi_type_builtin(builtin_type).\n\n:- type builtin_map --->\n builtin_map(\n % Items that should be avaiable without any module qualification.\n bm_root_map :: map(nq_name, builtin_item),\n\n % Items that should be available under the builtin_module_name\n % module.\n bm_builtin_map :: map(nq_name, builtin_item)\n ).\n\n % setup_builtins(Map, Operators, !Core)\n %\n:- pred setup_builtins(builtin_map::out,\n operators::out, core::in, core::out) is det.\n\n:- func builtin_module_name = q_name.\n\n%-----------------------------------------------------------------------%\n%\n% PZ Builtins\n%\n\n:- type pz_builtin_ids\n ---> pz_builtin_ids(\n pbi_make_tag :: pzi_id,\n pbi_shift_make_tag :: pzi_id,\n pbi_break_tag :: pzi_id,\n pbi_break_shift_tag :: pzi_id,\n pbi_unshift_value :: pzi_id,\n\n % A struct containing only a secondary tag.\n % TODO: actually make this imported so that the runtime\n % structures can be shared easily.\n pbi_stag_struct :: pzs_id\n ).\n\n % Setup procedures that are PZ builtins but not Plasma builtins. For\n % example things like tagged pointer manipulation.\n %\n:- pred setup_pz_builtin_procs(pz_builtin_ids::out, pz::in, pz::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module list.\n:- import_module pair.\n:- import_module require.\n:- import_module set.\n\n:- import_module context.\n:- import_module core.code.\n:- import_module core.function.\n:- import_module core.resource.\n:- import_module core_to_pz.\n:- import_module pz.code.\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\nsetup_builtins(!:Map, Operators, !Core) :-\n !:Map = builtin_map(init, init),\n setup_core_types(MaybeType, !Map, !Core),\n setup_bool_builtins(BoolType, BoolTrue, BoolFalse, BoolAnd, BoolOr,\n BoolNot, !Map, !Core),\n setup_int_builtins(BoolType,\n IntAdd, IntSub, IntMul, IntDiv, IntMod,\n IntGt, IntLt, IntGtEq, IntLtEq, IntEq, IntNEq, IntMinus,\n !Map, !Core),\n setup_list_builtins(ListType, ListNil, ListCons, !Map, !Core),\n setup_string_builtins(BoolType, MaybeType,\n StringConcat, !Map, !Core),\n setup_misc_builtins(BoolType, BoolTrue, BoolFalse, !Map, !Core),\n\n Operators = operators(\n IntAdd, IntSub, IntMul, IntDiv, IntMod,\n IntGt, IntLt, IntGtEq, IntLtEq, IntEq, IntNEq, IntMinus,\n BoolTrue, BoolFalse, BoolAnd, BoolOr, BoolNot,\n ListType, ListNil, ListCons,\n StringConcat),\n\n foldl(make_body_for_inline, core_all_functions(!.Core), !Core).\n\n:- pred setup_core_types(type_id::out, builtin_map::in, builtin_map::out,\n core::in, core::out) is det.\n\nsetup_core_types(MaybeType, !Map, !Core) :-\n foldl((pred(Type::in, M0::in, M::out) is det :-\n builtin_type_name(Type, Name),\n root_name(Name, bi_type_builtin(Type), M0, M)\n ), [int, codepoint, string, string_pos], !Map),\n\n core_allocate_type_id(MaybeType, !Core),\n MaybeParamName = \"v\",\n\n NoneName = nq_name_det(\"None\"),\n NoneQName = q_name_append(builtin_module_name, NoneName),\n core_allocate_ctor_id(NoneId, !Core),\n core_set_constructor(NoneId, NoneQName, MaybeType,\n constructor(NoneQName, [MaybeParamName], []), !Core),\n root_name(NoneName, bi_ctor(NoneId), !Map),\n\n SomeName = nq_name_det(\"Some\"),\n SomeQName = q_name_append(builtin_module_name, SomeName),\n core_allocate_ctor_id(SomeId, !Core),\n core_set_constructor(SomeId, SomeQName, MaybeType,\n constructor(SomeQName, [MaybeParamName], [\n type_field(q_name_append_str(builtin_module_name, \"value\"),\n type_variable(MaybeParamName))]), !Core),\n root_name(SomeName, bi_ctor(SomeId), !Map),\n\n MaybeName = nq_name_det(\"Maybe\"),\n core_set_type(MaybeType,\n type_init(q_name_append(builtin_module_name, MaybeName),\n [MaybeParamName], [NoneId, SomeId], so_private, i_imported,\n builtin_context),\n !Core),\n root_name(MaybeName, bi_type(MaybeType, arity(1)), !Map).\n\n % If a function is implemented by inlining PZ instructions during\n % codegen, then give it a definition that does the same so it can be\n % used as a higher order value.\n %\n:- pred make_body_for_inline(pair(func_id, function)::in,\n core::in, core::out) is det.\n\nmake_body_for_inline(FuncId - Function0, !Core) :-\n ( if func_builtin_inline_pz(Function0, _) then\n func_get_type_signature(Function0, ParamTypes, ReturnTypes, Arity),\n func_get_resource_signature(Function0, Uses, Observes),\n some [!Varmap, !Typemap, !CodeInfo] (\n !:Varmap = varmap.init,\n !:Typemap = init,\n map_foldl2(add_var_with_type, ParamTypes, Params, !Varmap,\n !Typemap),\n % The whacky thing here is that to implement a function whose\n % contents get replaced by a list of PZ instructions, we implement\n % it as a call to itself, because that direct call will be replaced\n % with the PZ instructions during codegen.\n Callee = c_plain(FuncId),\n Resources = resources(Uses, Observes),\n !:CodeInfo = code_info_init(o_builtin),\n code_info_set_arity(Arity, !CodeInfo),\n code_info_set_types(ReturnTypes, !CodeInfo),\n % XXX: If we add extra parts to code_info in the future then\n % this may be incomplete. We need a typesafe way to make a\n % complete one or we should run this code through the\n % typechecker etc.\n Expr = expr(e_call(Callee, Params, Resources), !.CodeInfo),\n func_set_body(!.Varmap, Params, [], Expr, !.Typemap,\n Function0, Function),\n core_set_function(FuncId, Function, !Core)\n )\n else\n true\n ).\n\n:- pred add_var_with_type(type_::in, var::out, varmap::in, varmap::out,\n map(var, type_)::in, map(var, type_)::out) is det.\n\nadd_var_with_type(Type, Var, !Varmap, !Typemap) :-\n add_anon_var(Var, !Varmap),\n det_insert(Var, Type, !Typemap).\n\n%-----------------------------------------------------------------------%\n\n:- pred setup_bool_builtins(type_id::out, ctor_id::out, ctor_id::out,\n func_id::out, func_id::out, func_id::out,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nsetup_bool_builtins(BoolId, TrueId, FalseId, AndId, OrId, NotId, !Map, !Core) :-\n core_allocate_type_id(BoolId, !Core),\n\n FalseName = nq_name_det(\"False\"),\n FalseQName = q_name_append(builtin_module_name, FalseName),\n core_allocate_ctor_id(FalseId, !Core),\n core_set_constructor(FalseId, FalseQName, BoolId,\n constructor(FalseQName, [], []), !Core),\n root_name(FalseName, bi_ctor(FalseId), !Map),\n\n TrueName = nq_name_det(\"True\"),\n TrueQName = q_name_append(builtin_module_name, TrueName),\n core_allocate_ctor_id(TrueId, !Core),\n core_set_constructor(TrueId, TrueQName, BoolId,\n constructor(TrueQName, [], []), !Core),\n root_name(TrueName, bi_ctor(TrueId), !Map),\n\n % NOTE: False is first so that it is allocated 0 for its tag, and true\n % will be allocated 1 for its tag, this will make interoperability\n % easier.\n BoolName = nq_name_det(\"Bool\"),\n core_set_type(BoolId,\n type_init(q_name_append(builtin_module_name, BoolName), [],\n [FalseId, TrueId], so_private, i_imported, builtin_context),\n !Core),\n root_name(BoolName, bi_type(BoolId, arity(0)), !Map),\n\n BoolWidth = bool_width,\n BoolNotName = nq_name_det(\"bool_not\"),\n register_builtin_func_builtin(BoolNotName,\n func_init_builtin_inline_pz(\n q_name_append(builtin_module_name, BoolNotName),\n [type_ref(BoolId, [])], [type_ref(BoolId, [])], init, init,\n [pzi_not(BoolWidth)]),\n NotId, !Map, !Core),\n\n register_bool_biop(BoolId, \"bool_and\",\n [pzi_and(BoolWidth)], AndId, !Map, !Core),\n register_bool_biop(BoolId, \"bool_or\",\n [pzi_or(BoolWidth)], OrId, !Map, !Core).\n\n:- pred register_bool_biop(type_id::in, string::in, list(pz_instr)::in,\n func_id::out, builtin_map::in, builtin_map::out, core::in, core::out)\n is det.\n\nregister_bool_biop(BoolType, NameStr, Defn, FuncId, !Map, !Core) :-\n Name = nq_name_det(NameStr),\n FName = q_name_append(builtin_module_name, Name),\n register_builtin_func_builtin(Name,\n func_init_builtin_inline_pz(FName,\n [type_ref(BoolType, []), type_ref(BoolType, [])],\n [type_ref(BoolType, [])],\n init, init,\n Defn),\n FuncId, !Map, !Core).\n\n%-----------------------------------------------------------------------%\n\n:- pred setup_int_builtins(type_id::in,\n func_id::out, func_id::out, func_id::out, func_id::out, func_id::out,\n func_id::out, func_id::out, func_id::out, func_id::out, func_id::out,\n func_id::out, func_id::out,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nsetup_int_builtins(BoolType,\n AddId, SubId, MulId, DivId, ModId,\n GtId, LtId, GtEqId, LtEqId, EqId, NEqId, MinusId,\n !Map, !Core) :-\n register_int_fn2(\"int_add\", [pzi_add(pzw_fast)], AddId,\n !Map, !Core),\n register_int_fn2(\"int_sub\", [pzi_sub(pzw_fast)], SubId,\n !Map, !Core),\n register_int_fn2(\"int_mul\", [pzi_mul(pzw_fast)], MulId,\n !Map, !Core),\n % Mod and div can maybe be combined into one operator, and optimised at\n % PZ load time.\n register_int_fn2(\"int_div\", [pzi_div(pzw_fast)], DivId,\n !Map, !Core),\n register_int_fn2(\"int_mod\", [pzi_mod(pzw_fast)], ModId,\n !Map, !Core),\n\n % TODO: remove the extend operation once we fix how booleans are\n % stored.\n BoolWidth = bool_width,\n require(unify(BoolWidth, pzw_ptr),\n \"Fix this code once we fix bool storage\"),\n register_int_comp(BoolType, \"int_gt\", [\n pzi_gt_s(pzw_fast),\n pzi_ze(pzw_fast, pzw_ptr)],\n GtId, !Map, !Core),\n register_int_comp(BoolType, \"int_lt\", [\n pzi_lt_s(pzw_fast),\n pzi_ze(pzw_fast, pzw_ptr)],\n LtId, !Map, !Core),\n register_int_comp(BoolType, \"int_gteq\", [\n pzi_lt_s(pzw_fast),\n pzi_not(pzw_fast),\n pzi_ze(pzw_fast, pzw_ptr)],\n GtEqId, !Map, !Core),\n register_int_comp(BoolType, \"int_lteq\", [\n pzi_gt_s(pzw_fast),\n pzi_not(pzw_fast),\n pzi_ze(pzw_fast, pzw_ptr)],\n LtEqId, !Map, !Core),\n register_int_comp(BoolType, \"int_eq\", [\n pzi_eq(pzw_fast),\n pzi_ze(pzw_fast, pzw_ptr)],\n EqId, !Map, !Core),\n register_int_comp(BoolType, \"int_neq\", [\n pzi_eq(pzw_fast),\n pzi_not(pzw_fast),\n pzi_ze(pzw_fast, pzw_ptr)],\n NEqId, !Map, !Core),\n\n register_int_fn1(\"int_minus\",\n [pzi_load_immediate(pzw_fast, im_i32(0i32)),\n pzi_roll(2),\n pzi_sub(pzw_fast)],\n MinusId, !Map, !Core),\n\n % Register the builtin bitwise functions..\n % TODO: make the number of bits to shift a single byte.\n register_int_fn2(\"int_lshift\",\n [pzi_trunc(pzw_fast, pzw_8),\n pzi_lshift(pzw_fast)], _, !Map, !Core),\n register_int_fn2(\"int_rshift\",\n [pzi_trunc(pzw_fast, pzw_8),\n pzi_rshift(pzw_fast)], _, !Map, !Core),\n register_int_fn2(\"int_and\", [pzi_and(pzw_fast)], _, !Map, !Core),\n register_int_fn2(\"int_or\", [pzi_or(pzw_fast)], _, !Map, !Core),\n register_int_fn2(\"int_xor\",\n [pzi_xor(pzw_fast)], _, !Map, !Core),\n register_int_fn1(\"int_comp\",\n [pzi_load_immediate(pzw_32, im_i32(-1i32)),\n pzi_se(pzw_32, pzw_fast),\n pzi_xor(pzw_fast)],\n _, !Map, !Core).\n\n:- pred register_int_fn1(string::in, list(pz_instr)::in, func_id::out,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nregister_int_fn1(NameStr, Defn, FuncId, !Map, !Core) :-\n Name = nq_name_det(NameStr),\n FName = q_name_append(builtin_module_name, Name),\n register_builtin_func_builtin(Name,\n func_init_builtin_inline_pz(FName,\n [builtin_type(int)], [builtin_type(int)],\n init, init, Defn),\n FuncId, !Map, !Core).\n\n:- pred register_int_fn2(string::in, list(pz_instr)::in, func_id::out,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nregister_int_fn2(NameStr, Defn, FuncId, !Map, !Core) :-\n Name = nq_name_det(NameStr),\n FName = q_name_append(builtin_module_name, Name),\n register_builtin_func_builtin(Name,\n func_init_builtin_inline_pz(FName,\n [builtin_type(int), builtin_type(int)],\n [builtin_type(int)],\n init, init, Defn),\n FuncId, !Map, !Core).\n\n:- pred register_int_comp(type_id::in, string::in, list(pz_instr)::in,\n func_id::out, builtin_map::in, builtin_map::out,\n core::in, core::out) is det.\n\nregister_int_comp(BoolType, NameStr, Defn, FuncId, !Map, !Core) :-\n Name = nq_name_det(NameStr),\n FName = q_name_append(builtin_module_name, Name),\n register_builtin_func_builtin(Name,\n func_init_builtin_inline_pz(FName,\n [builtin_type(int), builtin_type(int)],\n [type_ref(BoolType, [])],\n init, init, Defn),\n FuncId, !Map, !Core).\n\n:- pred setup_list_builtins(type_id::out, ctor_id::out, ctor_id::out,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nsetup_list_builtins(ListId, NilId, ConsId, !Map, !Core) :-\n core_allocate_type_id(ListId, !Core),\n T = \"T\",\n\n NilName = nq_name_det(\"list_nil\"),\n NilQName = q_name_append(builtin_module_name, NilName),\n core_allocate_ctor_id(NilId, !Core),\n core_set_constructor(NilId, NilQName, ListId,\n constructor(NilQName, [T], []), !Core),\n builtin_name(NilName, bi_ctor(NilId), !Map),\n\n Head = q_name_append_str(builtin_module_name, \"head\"),\n Tail = q_name_append_str(builtin_module_name, \"tail\"),\n ConsName = nq_name_det(\"list_cons\"),\n ConsQName = q_name_append(builtin_module_name, ConsName),\n core_allocate_ctor_id(ConsId, !Core),\n core_set_constructor(ConsId, ConsQName, ListId,\n constructor(ConsQName, [T],\n [type_field(Head, type_variable(T)),\n type_field(Tail, type_ref(ListId, [type_variable(T)]))]), !Core),\n builtin_name(ConsName, bi_ctor(ConsId), !Map),\n\n core_set_type(ListId,\n type_init(q_name_append_str(builtin_module_name, \"List\"), [T],\n [NilId, ConsId], so_private, i_imported, builtin_context),\n !Core),\n\n root_name(nq_name_det(\"List\"), bi_type(ListId, arity(1)), !Map).\n\n%-----------------------------------------------------------------------%\n\n:- pred setup_misc_builtins(type_id::in, ctor_id::in, ctor_id::in,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nsetup_misc_builtins(BoolType, BoolTrue, BoolFalse, !Map, !Core) :-\n register_builtin_resource(nq_name_det(\"IO\"), r_io, RIO, !Map, !Core),\n\n PrintName = q_name_append_str(builtin_module_name, \"print\"),\n register_builtin_func_root(nq_name_det(\"print\"),\n func_init_builtin_rts(PrintName,\n [builtin_type(string)], [], list_to_set([RIO]), init),\n _, !Map, !Core),\n\n core_allocate_type_id(IOResultType, !Core),\n\n % There's currently no error constructor. but there should be, currently\n % the runtime just aborts.\n OkParamName = \"v\",\n OkName = nq_name_det(\"Ok\"),\n OkQName = q_name_append(builtin_module_name, OkName),\n core_allocate_ctor_id(OkId, !Core),\n core_set_constructor(OkId, OkQName, IOResultType,\n constructor(OkQName, [OkParamName], [\n type_field(q_name_append_str(builtin_module_name, \"value\"),\n type_variable(OkParamName))]), !Core),\n root_name(OkName, bi_ctor(OkId), !Map),\n\n EOFName = nq_name_det(\"EOF\"),\n EOFQName = q_name_append(builtin_module_name, EOFName),\n core_allocate_ctor_id(EOFId, !Core),\n core_set_constructor(EOFId, EOFQName, IOResultType,\n constructor(EOFQName, [OkParamName], []), !Core),\n root_name(EOFName, bi_ctor(EOFId), !Map),\n\n IOResultName = nq_name_det(\"IOResult\"),\n core_set_type(IOResultType,\n type_init(q_name_append(builtin_module_name, IOResultName),\n [OkParamName], [OkId, EOFId], so_private, i_imported, builtin_context),\n !Core),\n root_name(IOResultName, bi_type(IOResultType, arity(1)), !Map),\n\n ReadlnName = q_name_append_str(builtin_module_name, \"readline\"),\n register_builtin_func_root(nq_name_det(\"readline\"),\n func_init_builtin_rts(ReadlnName,\n [], [type_ref(IOResultType, [builtin_type(string)])],\n list_to_set([RIO]), init),\n _, !Map, !Core),\n\n IntToStringName = q_name_append_str(builtin_module_name, \"int_to_string\"),\n register_builtin_func_root(nq_name_det(\"int_to_string\"),\n func_init_builtin_rts(IntToStringName,\n [builtin_type(int)], [builtin_type(string)], init, init),\n _, !Map, !Core),\n\n BoolToStringName = q_name_append_str(builtin_module_name, \"bool_to_string\"),\n BoolToString0 = func_init_builtin_core(BoolToStringName,\n [type_ref(BoolType, [])], [builtin_type(string)], init, init),\n define_bool_to_string(BoolTrue, BoolFalse, BoolToString0, BoolToString),\n register_builtin_func_root(nq_name_det(\"bool_to_string\"), BoolToString,\n _, !Map, !Core),\n\n SetParameterName = q_name_append_str(builtin_module_name, \"set_parameter\"),\n register_builtin_func_builtin(nq_name_det(\"set_parameter\"),\n func_init_builtin_rts(SetParameterName,\n [builtin_type(string), builtin_type(int)],\n [type_ref(BoolType, [])],\n list_to_set([RIO]), init),\n _, !Map, !Core),\n\n GetParameterName = q_name_append_str(builtin_module_name, \"get_parameter\"),\n register_builtin_func_builtin(nq_name_det(\"get_parameter\"),\n func_init_builtin_rts(GetParameterName,\n [builtin_type(string)],\n [type_ref(BoolType, []), builtin_type(int)],\n init, list_to_set([RIO])),\n _, !Map, !Core),\n\n EnvironmentName = nq_name_det(\"Environment\"),\n EnvironmentQName = q_name_append(builtin_module_name, EnvironmentName),\n register_builtin_resource(EnvironmentName,\n r_other(EnvironmentQName, RIO, so_private, i_imported, builtin_context),\n REnv, !Map, !Core),\n SetenvName = q_name_append_str(builtin_module_name, \"setenv\"),\n register_builtin_func_root(nq_name_det(\"setenv\"),\n func_init_builtin_rts(SetenvName,\n [builtin_type(string), builtin_type(string)],\n [type_ref(BoolType, [])],\n list_to_set([REnv]), init),\n _, !Map, !Core),\n\n TimeName = nq_name_det(\"Time\"),\n TimeQName = q_name_append(builtin_module_name, TimeName),\n register_builtin_resource(TimeName,\n r_other(TimeQName, RIO, so_private, i_imported, builtin_context),\n RTime, !Map, !Core),\n GettimeofdayName = q_name_append_str(builtin_module_name, \"gettimeofday\"),\n register_builtin_func_builtin(nq_name_det(\"gettimeofday\"),\n func_init_builtin_rts(GettimeofdayName, [],\n [type_ref(BoolType, []), builtin_type(int), builtin_type(int)],\n init, list_to_set([RTime])),\n _, !Map, !Core),\n\n DieName = nq_name_det(\"die\"),\n DieQName = q_name_append(builtin_module_name, DieName),\n register_builtin_func_builtin(DieName,\n func_init_builtin_rts(DieQName, [builtin_type(string)], [],\n init, init),\n _, !Map, !Core).\n\n%-----------------------------------------------------------------------%\n\n:- pred setup_string_builtins(type_id::in, type_id::in,\n func_id::out,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nsetup_string_builtins(BoolType, MaybeType, StringConcat, !Map, !Core) :-\n core_allocate_type_id(CodepointCategoryId, !Core),\n\n % TODO: Implement more character classes.\n WhitespaceName = nq_name_det(\"Whitespace\"),\n WhitespaceQName = q_name_append(builtin_module_name, WhitespaceName),\n core_allocate_ctor_id(WhitespaceId, !Core),\n core_set_constructor(WhitespaceId, WhitespaceQName, CodepointCategoryId,\n constructor(WhitespaceQName, [], []), !Core),\n root_name(WhitespaceName, bi_ctor(WhitespaceId), !Map),\n\n OtherName = nq_name_det(\"Other\"),\n OtherQName = q_name_append(builtin_module_name, OtherName),\n core_allocate_ctor_id(OtherId, !Core),\n core_set_constructor(OtherId, OtherQName, CodepointCategoryId,\n constructor(OtherQName, [], []), !Core),\n root_name(OtherName, bi_ctor(OtherId), !Map),\n\n CodepointCategoryTypeName = nq_name_det(\"CodepointCategory\"),\n core_set_type(CodepointCategoryId,\n type_init(q_name_append(builtin_module_name,\n CodepointCategoryTypeName), [],\n [WhitespaceId, OtherId], so_private, i_imported, builtin_context),\n !Core),\n root_name(CodepointCategoryTypeName,\n bi_type(CodepointCategoryId, arity(0)), !Map),\n\n CodepointCategoryName = nq_name_det(\"codepoint_category\"),\n register_builtin_func_root(CodepointCategoryName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, CodepointCategoryName),\n [builtin_type(codepoint)],\n [type_ref(CodepointCategoryId, [])],\n init, init),\n _, !Map, !Core),\n\n CPToStringName = nq_name_det(\"codepoint_to_string\"),\n register_builtin_func_root(CPToStringName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, CPToStringName),\n [builtin_type(codepoint)],\n [builtin_type(string)],\n init, init),\n _, !Map, !Core),\n\n\n CPToNumName = nq_name_det(\"codepoint_to_number\"),\n register_builtin_func_root(CPToNumName,\n func_init_builtin_inline_pz(\n q_name_append(builtin_module_name, CPToNumName),\n [builtin_type(codepoint)],\n [builtin_type(int)],\n init, init, [pzi_ze(pzw_32, pzw_fast)]),\n _, !Map, !Core),\n\n IntToCPName = nq_name_det(\"int_to_codepoint\"),\n register_builtin_func_builtin(IntToCPName,\n func_init_builtin_inline_pz(\n q_name_append(builtin_module_name, IntToCPName),\n [builtin_type(int)],\n [builtin_type(codepoint)],\n init, init, [pzi_trunc(pzw_fast, pzw_32)]),\n _, !Map, !Core),\n\n StringConcatName = nq_name_det(\"string_concat\"),\n register_builtin_func_builtin(StringConcatName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, StringConcatName),\n [builtin_type(string), builtin_type(string)],\n [builtin_type(string)],\n init, init),\n StringConcat, !Map, !Core),\n\n StrposForwadName = nq_name_det(\"strpos_forward\"),\n register_builtin_func_root(StrposForwadName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, StrposForwadName),\n [builtin_type(string_pos)],\n [builtin_type(string_pos)],\n init, init),\n _, !Map, !Core),\n\n StrposBackwardName = nq_name_det(\"strpos_backward\"),\n register_builtin_func_root(StrposBackwardName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, StrposBackwardName),\n [builtin_type(string_pos)],\n [builtin_type(string_pos)],\n init, init),\n _, !Map, !Core),\n\n StrposNextName = nq_name_det(\"strpos_next\"),\n register_builtin_func_root(StrposNextName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, StrposNextName),\n [builtin_type(string_pos)],\n [type_ref(MaybeType, [builtin_type(codepoint)])],\n init, init),\n _, !Map, !Core),\n\n StrposPrevName = nq_name_det(\"strpos_prev\"),\n register_builtin_func_root(StrposPrevName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, StrposPrevName),\n [builtin_type(string_pos)],\n [type_ref(MaybeType, [builtin_type(codepoint)])],\n init, init),\n _, !Map, !Core),\n\n StringBeginName = nq_name_det(\"string_begin\"),\n register_builtin_func_root(StringBeginName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, StringBeginName),\n [builtin_type(string)],\n [builtin_type(string_pos)],\n init, init),\n _, !Map, !Core),\n\n StringEndName = nq_name_det(\"string_end\"),\n register_builtin_func_root(StringEndName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, StringEndName),\n [builtin_type(string)],\n [builtin_type(string_pos)],\n init, init),\n _, !Map, !Core),\n\n StringSubstringName = nq_name_det(\"string_substring\"),\n register_builtin_func_root(StringSubstringName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, StringSubstringName),\n [builtin_type(string_pos), builtin_type(string_pos)],\n [builtin_type(string)],\n init, init),\n _, !Map, !Core),\n\n StringEqualsName = nq_name_det(\"string_equals\"),\n register_builtin_func_root(StringEqualsName,\n func_init_builtin_rts(\n q_name_append(builtin_module_name, StringEqualsName),\n [builtin_type(string), builtin_type(string)],\n [type_ref(BoolType, [])],\n init, init),\n _, !Map, !Core).\n\n%-----------------------------------------------------------------------%\n\n % Register the builtin function with it's name in the root namespace.\n %\n:- pred register_builtin_func_root(nq_name::in, function::in, func_id::out,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nregister_builtin_func_root(Name, Func, FuncId, !Map, !Core) :-\n register_builtin_func(Func, FuncId, !Core),\n root_name(Name, bi_func(FuncId), !Map).\n\n % Register the builtin function with it's name in the Builtin module\n % namespace.\n %\n:- pred register_builtin_func_builtin(nq_name::in, function::in, func_id::out,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nregister_builtin_func_builtin(Name, Func, FuncId, !Map, !Core) :-\n register_builtin_func(Func, FuncId, !Core),\n builtin_name(Name, bi_func(FuncId), !Map).\n\n:- pred register_builtin_func(function::in, func_id::out,\n core::in, core::out) is det.\n\nregister_builtin_func(Func, FuncId, !Core) :-\n core_allocate_function(FuncId, !Core),\n core_set_function(FuncId, Func, !Core).\n\n:- pred register_builtin_resource(nq_name::in, resource::in,\n resource_id::out,\n builtin_map::in, builtin_map::out, core::in, core::out) is det.\n\nregister_builtin_resource(Name, Res, ResId, !Map, !Core) :-\n core_allocate_resource_id(ResId, !Core),\n core_set_resource(ResId, Res, !Core),\n root_name(Name, bi_resource(ResId), !Map).\n\n%-----------------------------------------------------------------------%\n\n:- pred define_bool_to_string(ctor_id::in, ctor_id::in,\n function::in, function::out) is det.\n\ndefine_bool_to_string(TrueId, FalseId, !Func) :-\n some [!Varmap] (\n !:Varmap = init,\n CI = code_info_init(o_builtin),\n\n varmap.add_anon_var(In, !Varmap),\n TrueCase = e_case(p_ctor(make_singleton_set(TrueId), []),\n expr(e_constant(c_string(\"True\")), CI)),\n FalseCase = e_case(p_ctor(make_singleton_set(FalseId), []),\n expr(e_constant(c_string(\"False\")), CI)),\n Expr = expr(e_match(In, [TrueCase, FalseCase]), CI),\n func_set_body(!.Varmap, [In], [], Expr, !Func)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred root_name(nq_name::in, builtin_item::in,\n builtin_map::in, builtin_map::out) is det.\n\nroot_name(Name, Item, !Map) :-\n det_insert(Name, Item, !.Map ^ bm_root_map, Map),\n !Map ^ bm_root_map := Map.\n\n:- pred builtin_name(nq_name::in, builtin_item::in,\n builtin_map::in, builtin_map::out) is det.\n\nbuiltin_name(Name, Item, !Map) :-\n det_insert(Name, Item, !.Map ^ bm_builtin_map, Map),\n !Map ^ bm_builtin_map := Map.\n\n%-----------------------------------------------------------------------%\n\nbuiltin_module_name = q_name_single(\"Builtin\").\n\n%-----------------------------------------------------------------------%\n\nsetup_pz_builtin_procs(BuiltinProcs, !PZ) :-\n % pz_signature([pzw_ptr, pzw_ptr], [pzw_ptr])\n pz_new_import(MakeTag, pz_import(make_tag_qname, pzit_import), !PZ),\n\n % pz_signature([pzw_ptr, pzw_ptr], [pzw_ptr])\n pz_new_import(ShiftMakeTag, pz_import(shift_make_tag_qname, pzit_import),\n !PZ),\n\n % pz_signature([pzw_ptr], [pzw_ptr, pzw_ptr])\n pz_new_import(BreakTag, pz_import(break_tag_qname, pzit_import), !PZ),\n\n % pz_signature([pzw_ptr], [pzw_ptr, pzw_ptr])\n pz_new_import(BreakShiftTag,\n pz_import(break_shift_tag_qname, pzit_import), !PZ),\n\n % pz_signature([pzw_ptr], [pzw_ptr])\n pz_new_import(UnshiftValue, pz_import(unshift_value_qname, pzit_import),\n !PZ),\n\n STagStruct = pz_struct([pzw_fast]),\n pz_new_struct_id(STagStructId, \"Secondary tag struct\", !PZ),\n pz_add_struct(STagStructId, STagStruct, !PZ),\n\n BuiltinProcs = pz_builtin_ids(MakeTag, ShiftMakeTag, BreakTag,\n BreakShiftTag, UnshiftValue, STagStructId).\n\n%-----------------------------------------------------------------------%\n\n:- func make_tag_qname = q_name.\n\nmake_tag_qname = q_name_append_str(builtin_module_name, \"make_tag\").\n\n:- func shift_make_tag_qname = q_name.\n\nshift_make_tag_qname = q_name_append_str(builtin_module_name, \"shift_make_tag\").\n\n:- func break_tag_qname = q_name.\n\nbreak_tag_qname = q_name_append_str(builtin_module_name, \"break_tag\").\n\n:- func break_shift_tag_qname = q_name.\n\nbreak_shift_tag_qname = q_name_append_str(builtin_module_name, \"break_shift_tag\").\n\n:- func unshift_value_qname = q_name.\n\nunshift_value_qname = q_name_append_str(builtin_module_name, \"unshift_value\").\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/common_types.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module common_types.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module defines types useful to multiple Plasma tools.\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module set.\n\n:- import_module util.\n:- import_module util.pretty.\n\n % Is a declaration visible outside of its defining module.\n %\n:- type sharing\n ---> s_public\n ; s_private.\n\n % Types and resources have a 3rd option, to export the name but not its\n % details.\n %\n:- type sharing_opaque\n ---> so_private\n ; so_public\n ; so_public_opaque.\n\n % Is an exported function an entrypoint.\n %\n:- type is_entrypoint\n ---> is_entrypoint\n ; not_entrypoint.\n\n % Has a declaration been imported from another module?\n %\n:- type imported\n ---> i_local\n ; i_imported.\n\n % The arity of an expression is the number of results it returns.\n %\n:- type arity\n ---> arity(a_num :: int).\n\n % The number of a particular field within a structure. This is 1-based,\n % that is the first field is field_num_(1).\n %\n:- type field_num\n ---> field_num(field_num_int :: int).\n\n:- func field_num_first = field_num.\n\n:- func field_num_next(field_num) = field_num.\n\n%-----------------------------------------------------------------------%\n\n % A constant in an expression.\n %\n:- type const_type\n ---> c_string(string)\n ; c_number(int)\n ; c_func(func_id)\n ; c_ctor(set(ctor_id)).\n\n:- type id_printer(ID) == (func(ID) = pretty).\n\n:- func const_pretty(id_printer(func_id), id_printer(set(ctor_id)),\n const_type) = pretty.\n\n%-----------------------------------------------------------------------%\n\n:- type func_id\n ---> func_id(int).\n\n%-----------------------------------------------------------------------%\n\n:- type type_id\n ---> type_id(int).\n\n%-----------------------------------------------------------------------%\n\n:- type resource_id\n ---> resource_id(int).\n\n:- type maybe_resources\n ---> resources(\n r_uses :: set(resource_id),\n r_observes :: set(resource_id)\n )\n ; unknown_resources.\n\n%-----------------------------------------------------------------------%\n\n:- type ctor_id\n ---> ctor_id(int).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module int.\n:- import_module string.\n\n:- import_module util.my_string.\n\n%-----------------------------------------------------------------------%\n\nfield_num_first = field_num(1).\n\nfield_num_next(field_num(Num)) = field_num(Num + 1).\n\n%-----------------------------------------------------------------------%\n\nconst_pretty(_, _, c_number(Int)) = p_str(string(Int)).\nconst_pretty(_, _, c_string(String)) =\n p_str(escape_string(String)).\nconst_pretty(FuncPretty, _, c_func(FuncId)) = FuncPretty(FuncId).\nconst_pretty(_, CtorPretty, c_ctor(CtorId)) = CtorPretty(CtorId).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/compile.m", "content": "%-----------------------------------------------------------------------%\n% Plasma compilation process\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module drives the compilation process. It sits between plzc.m which\n% interprets command line options to start the process and the other modules\n% to actually do the compilation.\n%\n%-----------------------------------------------------------------------%\n:- module compile.\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module io.\n:- import_module list.\n\n:- import_module ast.\n:- import_module common_types.\n:- import_module compile_error.\n:- import_module context.\n:- import_module core.\n:- import_module options.\n:- import_module pz.\n:- import_module pz.pz_ds.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- pred check_module_name(general_options::in, context::in, q_name::in,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\n:- pred process_declarations(general_options::in, ast::in,\n result_partial(core, compile_error)::out, io::di, io::uo) is det.\n\n:- pred compile(general_options::in, compile_options::in, ast::in,\n result_partial(pz, compile_error)::out, io::di, io::uo) is det.\n\n:- type typeres_exports\n ---> typeres_exports(\n te_resources :: list(q_name),\n te_types :: list({q_name, arity})\n ).\n\n:- func find_typeres_exports(general_options, ast) =\n result_partial(typeres_exports, compile_error).\n\n%-----------------------------------------------------------------------%\n\n % Exported so plzc can filter entries to process imports.\n %\n:- pred filter_entries(list(ast_entry)::in, list(ast_import)::out,\n list(nq_named(ast_resource))::out, list(nq_named(ast_type(nq_name)))::out,\n list(nq_named(ast_function))::out, list(ast_pragma)::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module map.\n:- import_module maybe.\n:- import_module string.\n\n:- import_module builtins.\n:- import_module constant.\n:- import_module core.arity_chk.\n:- import_module core.branch_chk.\n:- import_module core.pretty.\n:- import_module core.res_chk.\n:- import_module core.simplify.\n:- import_module core.type_chk.\n:- import_module core_to_pz.\n:- import_module core_to_pz.data.\n:- import_module dump_stage.\n:- import_module file_utils.\n:- import_module pre.\n:- import_module pre.ast_to_core.\n:- import_module pre.env.\n:- import_module pre.import.\n:- import_module pz.pretty.\n:- import_module util.my_exception.\n:- import_module util.log.\n:- import_module util.path.\n\n%-----------------------------------------------------------------------%\n\ncheck_module_name(GOptions, Context, ModuleName, !Errors) :-\n MbModuleNameCheck = GOptions ^ go_module_name_check,\n ( MbModuleNameCheck = no\n ; MbModuleNameCheck = yes(ModuleNameCheck),\n ( if q_name_to_string(ModuleName) = ModuleNameCheck then\n true\n else\n add_error(Context,\n ce_module_name_not_match_build(ModuleName, ModuleNameCheck),\n !Errors)\n )\n ),\n\n % The module name and file name are both converted to an internal\n % representation and then compared lexicographically. If that matches\n % then they match. This allows the file name to vary with case and\n % punctuation differences.\n\n ModuleNameStripped = strip_file_name_punctuation(\n q_name_to_string(ModuleName)),\n\n InputFileName = GOptions ^ go_input_file,\n file_part(InputFileName, InputFileNameNoPath),\n ( if\n filename_extension(source_extension, InputFileNameNoPath,\n InputFileNameBase),\n strip_file_name_punctuation(InputFileNameBase) = ModuleNameStripped\n then\n true\n else\n add_error(Context, ce_source_file_name_not_match_module(ModuleName,\n filename(InputFileName)),\n !Errors)\n ),\n\n OutputFileName = GOptions ^ go_output_file,\n ( if\n ( Extension = output_extension\n ; Extension = interface_extension\n ; Extension = typeres_extension\n ; Extension = depends_extension\n ),\n filename_extension(Extension, OutputFileName, OutputFileNameBase),\n strip_file_name_punctuation(OutputFileNameBase) = ModuleNameStripped\n then\n true\n else\n add_error(Context, ce_object_file_name_not_match_module(ModuleName,\n filename(OutputFileName)), !Errors)\n ).\n\n%-----------------------------------------------------------------------%\n\nprocess_declarations(GeneralOpts, ast(ModuleName, Context, Entries), Result,\n !IO) :-\n Verbose = GeneralOpts ^ go_verbose,\n some [!Env, !ImportEnv, !Core, !Errors] (\n !:Errors = init,\n\n check_module_name(GeneralOpts, Context, ModuleName, !Errors),\n filter_entries(Entries, Imports, Resources0, Types0, Funcs, _),\n\n setup_env_and_core(ModuleName, !:ImportEnv, !:Env, !:Core),\n\n map_foldl3(gather_resource(ModuleName), Resources0, Resources,\n !ImportEnv, !Env, !Core),\n map_foldl3(gather_type(ModuleName), Types0, Types,\n !ImportEnv, !Env, !Core),\n\n ast_to_core_imports(Verbose, ModuleName, typeres_import,\n !.ImportEnv, GeneralOpts ^ go_import_whitelist_file, Imports,\n !Env, !Core, !Errors, !IO),\n\n ast_to_core_declarations(GeneralOpts, Resources, Types, Funcs, !.Env,\n _, !Core, !Errors, !IO),\n\n ( if not has_fatal_errors(!.Errors) then\n Result = ok(!.Core, !.Errors)\n else\n Result = errors(!.Errors)\n )\n ).\n\n%-----------------------------------------------------------------------%\n\ncompile(GeneralOpts, CompileOpts, ast(ModuleName, Context, Entries), Result,\n !IO) :-\n Verbose = GeneralOpts ^ go_verbose,\n some [!Env, !ImportEnv, !Core, !Errors] (\n !:Errors = init,\n\n check_module_name(GeneralOpts, Context, ModuleName, !Errors),\n filter_entries(Entries, Imports, Resources0, Types0, Funcs, Pragmas),\n\n foldl(check_pragma, Pragmas, !Errors),\n\n setup_env_and_core(ModuleName, !:ImportEnv, !:Env, !:Core),\n\n map_foldl3(gather_resource(ModuleName), Resources0, Resources,\n !ImportEnv, !Env, !Core),\n map_foldl3(gather_type(ModuleName), Types0, Types,\n !ImportEnv, !Env, !Core),\n\n ast_to_core_imports(Verbose, ModuleName, interface_import, !.ImportEnv,\n GeneralOpts ^ go_import_whitelist_file, Imports,\n !Env, !Core, !Errors, !IO),\n\n ast_to_core_declarations(GeneralOpts, Resources, Types, Funcs,\n !Env, !Core, !Errors, !IO),\n\n ( if not has_fatal_errors(!.Errors) then\n verbose_output(Verbose,\n \"pre_to_core: Processing function bodies\\n\", !IO),\n ast_to_core_funcs(GeneralOpts, ModuleName, Funcs, !.Env,\n !Core, !Errors, !IO),\n ( if not has_fatal_errors(!.Errors) then\n maybe_dump_core_stage(GeneralOpts, \"core0_initial\", !.Core, !IO),\n semantic_checks(GeneralOpts, CompileOpts, !.Core,\n CoreResult, !IO),\n ( CoreResult = ok(!:Core),\n core_to_pz(GeneralOpts ^ go_verbose, CompileOpts, !.Core,\n PZ, TypeTagMap, ConstructorTagMap, !IO),\n maybe_dump_stage(GeneralOpts, module_name(!.Core),\n \"pz0_final\", pz_pretty, PZ, !IO),\n maybe_dump_stage(GeneralOpts, module_name(!.Core),\n \"data_rep\", data_rep_pretty,\n {!.Core, TypeTagMap, ConstructorTagMap}, !IO),\n Result = ok(PZ, !.Errors)\n ; CoreResult = errors(SemErrors),\n Result = errors(!.Errors ++ SemErrors)\n )\n else\n Result = errors(!.Errors)\n )\n else\n Result = errors(!.Errors)\n )\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred check_pragma(ast_pragma::in,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\ncheck_pragma(ast_pragma(Name, Args, Context), !Errors) :-\n ( if Name = \"foreign_include\" then\n % This is already checked in foreign.m but that only runs if we're\n % actually generating foreign code. Check it again here.\n ( if Args = [_] then\n true\n else\n add_error(Context, ce_pragma_bad_argument, !Errors)\n )\n else\n add_error(Context, ce_pragma_unknown(Name), !Errors)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred setup_env_and_core(q_name::in, env::out, env::out, core::out) is det.\n\nsetup_env_and_core(ModuleName, ImportEnv, Env, !:Core) :-\n !:Core = core.init(ModuleName),\n setup_builtins(BuiltinMap, Operators, !Core),\n InitEnv0 = env.init(Operators),\n\n % Setup those builtins that are always module qualified:\n map.foldl(env_add_builtin(func(Name) =\n q_name_append(builtin_module_name, Name)\n ), BuiltinMap ^ bm_builtin_map, InitEnv0, InitEnv),\n\n % Setup those that are sometimes qulaified, We split the Environment in\n % two to create an environment were they are (ImportEnv) and one where\n % they arn't (Env).\n map.foldl(env_add_builtin(q_name), BuiltinMap ^ bm_root_map, InitEnv, Env),\n map.foldl(env_add_builtin(func(Name) =\n q_name_append(builtin_module_name, Name)\n ), BuiltinMap ^ bm_root_map, InitEnv, ImportEnv).\n\n:- pred env_add_builtin((func(T) = q_name)::in, T::in, builtin_item::in,\n env::in, env::out) is det.\n\n % Resources and types arn't copied into the new namespace with\n % env_import_star. But that's okay because that actually needs\n % replacing in the future so will fix this then (TODO).\n %\nenv_add_builtin(MakeName, Name, bi_func(FuncId), !Env) :-\n env_add_func_det(MakeName(Name), FuncId, !Env).\nenv_add_builtin(MakeName, Name, bi_ctor(CtorId), !Env) :-\n env_add_constructor(MakeName(Name), CtorId, !Env).\nenv_add_builtin(MakeName, Name, bi_resource(ResId), !Env) :-\n env_add_resource_det(MakeName(Name), ResId, !Env).\nenv_add_builtin(MakeName, Name, bi_type(TypeId, Arity), !Env) :-\n env_add_type_det(MakeName(Name), Arity, TypeId, !Env).\nenv_add_builtin(MakeName, Name, bi_type_builtin(Builtin), !Env) :-\n env_add_builtin_type_det(MakeName(Name), Builtin, !Env).\n\n%-----------------------------------------------------------------------%\n\n:- pred gather_resource(q_name::in,\n nq_named(ast_resource)::in, a2c_resource::out,\n env::in, env::out, env::in, env::out, core::in, core::out) is det.\n\ngather_resource(ModuleName, nq_named(Name, Res),\n a2c_resource(Name, ResId, Res), !ImportEnv, !Env, !Core) :-\n core_allocate_resource_id(ResId, !Core),\n ( if\n env_add_resource(q_name(Name), ResId, !Env),\n Sharing = Res ^ ar_sharing,\n ( ( Sharing = so_public\n ; Sharing = so_public_opaque\n ),\n env_add_resource(q_name_append(ModuleName, Name), ResId,\n !ImportEnv)\n ; Sharing = so_private\n )\n then\n true\n else\n compile_error($file, $pred, \"Resource already defined\")\n ).\n\n:- pred gather_type(q_name::in, nq_named(ast_type(nq_name))::in, a2c_type::out,\n env::in, env::out, env::in, env::out, core::in, core::out) is det.\n\ngather_type(ModuleName, nq_named(Name, Type), a2c_type(Name, TypeId, Type),\n !ImportEnv, !Env, !Core) :-\n core_allocate_type_id(TypeId, !Core),\n Arity = type_arity(Type),\n ( if\n env_add_type(q_name(Name), Arity, TypeId, !Env),\n Sharing = Type ^ at_export,\n (\n ( Sharing = so_public\n ; Sharing = so_public_opaque\n ),\n env_add_type(q_name_append(ModuleName, Name), Arity, TypeId,\n !ImportEnv)\n ; Sharing = so_private\n )\n then\n true\n else\n compile_error($file, $pred, \"Type already defined\")\n ).\n\n%-----------------------------------------------------------------------%\n\nfind_typeres_exports(GeneralOpts, ast(ModuleName, Context, Entries)) =\n Result :-\n some [!Errors] (\n !:Errors = init,\n\n check_module_name(GeneralOpts, Context, ModuleName, !Errors),\n filter_entries(Entries, _, Resources0, Types0, _, _),\n\n filter_map((pred(NamedRes::in, Name::out) is semidet :-\n NamedRes = nq_named(NQName, ast_resource(_, Sharing, _)),\n ( Sharing = so_public\n ; Sharing = so_public_opaque\n ),\n Name = q_name_append(ModuleName, NQName)\n ),\n Resources0, Resources),\n\n filter_map((pred(NamedRes::in, {Name, Arity}::out) is semidet :-\n NamedRes = nq_named(NQName, ast_type(Params, _, Sharing, _)),\n ( Sharing = so_public\n ; Sharing = so_public_opaque\n ),\n Name = q_name_append(ModuleName, NQName),\n Arity = arity(length(Params))\n ),\n Types0, Types),\n\n ( if not has_fatal_errors(!.Errors) then\n Result = ok(typeres_exports(Resources, Types), !.Errors)\n else\n Result = errors(!.Errors)\n )\n ).\n\n%-----------------------------------------------------------------------%\n\nfilter_entries([], [], [], [], [], []).\nfilter_entries([E | Es], !:Is, !:Rs, !:Ts, !:Fs, !:Ps) :-\n filter_entries(Es, !:Is, !:Rs, !:Ts, !:Fs, !:Ps),\n ( E = ast_import(I),\n !:Is = [I | !.Is]\n ; E = ast_resource(N, R),\n !:Rs = [nq_named(N, R) | !.Rs]\n ; E = ast_type(N, T),\n !:Ts = [nq_named(N, T) | !.Ts]\n ; E = ast_function(N, F),\n !:Fs = [nq_named(N, F) | !.Fs]\n ; E = ast_pragma(P),\n !:Ps = [P | !.Ps]\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred semantic_checks(general_options::in, compile_options::in,\n core::in, result(core, compile_error)::out, io::di, io::uo) is det.\n\nsemantic_checks(GeneralOpts, CompileOpts, !.Core, Result, !IO) :-\n some [!Errors] (\n !:Errors = init,\n Verbose = GeneralOpts ^ go_verbose,\n\n verbose_output(Verbose, \"Core: arity checking\\n\", !IO),\n arity_check(Verbose, ArityErrors, !Core, !IO),\n maybe_dump_core_stage(GeneralOpts, \"core1_arity\", !.Core, !IO),\n add_errors(ArityErrors, !Errors),\n\n Simplify = CompileOpts ^ co_do_simplify,\n ( Simplify = do_simplify_pass,\n verbose_output(Verbose, \"Core: simplify pass\\n\", !IO),\n simplify(Verbose, SimplifyErrors, !Core, !IO),\n maybe_dump_core_stage(GeneralOpts, \"core2_simplify\", !.Core,\n !IO),\n add_errors(SimplifyErrors, !Errors)\n ; Simplify = skip_simplify_pass\n ),\n\n ( if not has_fatal_errors(!.Errors) then\n verbose_output(Verbose, \"Core: type checking\\n\", !IO),\n type_check(Verbose, TypecheckErrors, !Core, !IO),\n maybe_dump_core_stage(GeneralOpts, \"core3_typecheck\", !.Core,\n !IO),\n add_errors(TypecheckErrors, !Errors),\n\n verbose_output(Verbose, \"Core: branch checking\\n\", !IO),\n branch_check(Verbose, BranchcheckErrors, !Core, !IO),\n maybe_dump_core_stage(GeneralOpts, \"core4_branch\", !.Core, !IO),\n add_errors(BranchcheckErrors, !Errors),\n\n verbose_output(Verbose, \"Core: resource checking\\n\", !IO),\n res_check(Verbose, RescheckErrors, !Core, !IO),\n maybe_dump_core_stage(GeneralOpts, \"core5_res\", !.Core, !IO),\n add_errors(RescheckErrors, !Errors),\n\n ( if not has_fatal_errors(!.Errors) then\n Result = ok(!.Core)\n else\n Result = errors(!.Errors)\n )\n else\n Result = errors(!.Errors)\n )\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred maybe_dump_core_stage(general_options::in, string::in,\n core::in, io::di, io::uo) is det.\n\nmaybe_dump_core_stage(Opts, Stage, Core, !IO) :-\n maybe_dump_stage(Opts, module_name(Core), Stage, core_pretty, Core,\n !IO).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/compile_error.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module compile_error.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module defines possible Plasma compilation errors.\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module list.\n:- import_module maybe.\n\n:- import_module common_types.\n:- import_module core.\n:- import_module core.resource.\n:- import_module parse_util.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.pretty.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- type filename ---> filename(string).\n\n:- type compile_error\n % Errors for reading source code or the organisation of code (module and\n % file names don't match, etc).\n % This creates a dependency on the parser, I'm uneasy about\n % this.\n ---> ce_read_source_error(read_src_error)\n ; ce_module_name_not_match_build(q_name, string)\n ; ce_source_file_name_not_match_module(q_name, filename)\n ; ce_object_file_name_not_match_module(q_name, filename)\n ; ce_module_not_found(q_name)\n ; ce_module_unavailable(q_name, q_name)\n ; ce_interface_contains_wrong_module(filename, q_name, q_name)\n ; ce_import_would_clobber(q_name, maybe(q_name))\n ; ce_import_duplicate(q_name)\n\n % Generic errors with the binding of symbols.\n ; ce_function_already_defined(string)\n ; ce_entry_function_wrong_signature\n\n % Type related errors\n ; ce_type_already_defined(q_name)\n ; ce_type_duplicate_constructor(q_name)\n ; ce_type_not_known(q_name)\n ; ce_type_not_public_in_type(nq_name, nq_name)\n ; ce_type_not_public_in_func(nq_name, nq_name)\n ; ce_type_var_unknown(string)\n ; ce_type_has_incorrect_num_of_args(q_name, int, int)\n ; ce_builtin_type_with_args(q_name)\n ; ce_type_var_with_args(string)\n ; ce_type_error(type_error)\n ; ce_type_floundering(list(pretty), list(pretty))\n\n % Pattern matching\n ; ce_match_has_no_cases\n ; ce_match_does_not_cover_all_cases\n ; ce_match_unreached_cases\n ; ce_match_duplicate_case\n ; ce_match_on_function_type\n ; ce_case_does_not_define_all_variables(list(string))\n\n % Arity related.\n ; ce_arity_mismatch_func(arity, arity)\n ; ce_arity_mismatch_expr(arity, arity)\n ; ce_arity_mismatch_tuple\n ; ce_arity_mismatch_match(list(maybe(arity)))\n ; ce_parameter_number(int, int)\n ; ce_no_return_statement(arity)\n\n % Resource system\n ; ce_uses_observes_not_distinct(list(resource))\n ; ce_resource_unavailable_call\n ; ce_resource_unavailable_arg\n ; ce_resource_unavailable_output\n ; ce_resource_unknown(q_name)\n ; ce_resource_not_public_in_resource(nq_name, nq_name)\n ; ce_resource_not_public_in_type(nq_name, nq_name)\n ; ce_resource_not_public_in_function(nq_name, nq_name)\n ; ce_too_many_bangs_in_statement\n ; ce_no_bang\n ; ce_unnecessary_bang\n\n % Pragma related.\n ; ce_pragma_unknown(string)\n ; ce_pragma_bad_argument.\n\n:- type type_error\n ---> type_unification_failed(pretty, pretty, maybe(type_error))\n ; type_unification_occurs(pretty, pretty).\n\n:- instance error(compile_error).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\n:- instance error(compile_error) where [\n func(error_or_warning/1) is ce_error_or_warning,\n pred(pretty/4) is ce_to_pretty\n].\n\n:- func ce_error_or_warning(compile_error) = error_or_warning.\n\nce_error_or_warning(Error) =\n ( if\n Error = ce_unnecessary_bang\n ; Error = ce_import_duplicate(_)\n ; Error = ce_pragma_unknown(_)\n then\n warning\n else\n error\n ).\n\n:- pred ce_to_pretty(string::in, compile_error::in, list(pretty)::out,\n list(pretty)::out) is det.\n\nce_to_pretty(SrcPath, ce_read_source_error(E), Para, Extra) :-\n pretty(SrcPath, E, Para, Extra).\nce_to_pretty(_, ce_module_name_not_match_build(Module, ModuleInBuild),\n Para, []) :-\n Para = p_words(\"The module name from the source file\") ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(Module))] ++ p_spc_nl ++\n p_words(\"does not match the module name from the BUILD.plz file\") ++\n p_spc_nl ++\n [p_quote(\"'\", p_str(ModuleInBuild))].\nce_to_pretty(SrcPath, ce_source_file_name_not_match_module(Expect, Got), Para, []) :-\n Para = p_words(\"The source filename\") ++ p_spc_nl ++\n p_file(SrcPath, Got) ++ p_spc_nl ++\n p_words(\"does not match the module name\") ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(Expect))].\nce_to_pretty(SrcPath, ce_object_file_name_not_match_module(Expect, Got), Para, []) :-\n Para = p_words(\"The output filename\") ++ p_spc_nl ++\n p_file(SrcPath, Got) ++ p_spc_nl ++\n p_words(\"does not match the module name\") ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(Expect))].\nce_to_pretty(_, ce_module_not_found(Name), Para, []) :-\n Para = p_words(\"The interface file for the imported module\") ++ p_spc_nl ++\n [p_str(\"(\"), q_name_pretty(Name), p_str(\")\")] ++ p_spc_nl ++\n p_words(\"cannot be found. Was the module listed in BUILD.plz?\").\nce_to_pretty(_, ce_module_unavailable(Importee, Importer), Para, []) :-\n Para = p_words(\"The module\") ++ p_spc_nl ++\n [q_name_pretty(Importee)] ++ p_spc_nl ++\n p_words(\"can't be included because it is not listed in all the \" ++\n \"build file's module lists that include module\") ++ p_spc_nl ++\n [q_name_pretty(Importer)].\nce_to_pretty(SrcPath, ce_interface_contains_wrong_module(File, Expect, Got), Para, []) :-\n Para = p_words(\"The interface file\") ++ p_spc_nl ++\n p_file(SrcPath, File) ++ p_spc_nl ++\n p_words(\"describes the wrong module, got:\") ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(Got))] ++ p_spc_nl ++\n [p_str(\"expected:\")] ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(Expect))].\nce_to_pretty(_, ce_import_would_clobber(ModuleName, MaybeAsName), Para, []) :-\n ParaA = p_words(\"The import of\") ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(ModuleName))] ++ p_spc_nl,\n ( MaybeAsName = no,\n ParaB = p_words(\"clobbers a previous import to that name\")\n ; MaybeAsName = yes(AsName),\n ParaB = [p_str(\"clobbers\")] ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(AsName))] ++ p_spc_nl ++\n p_words(\"which is used by a previous import\")\n ),\n Para = ParaA ++ ParaB.\nce_to_pretty(_, ce_import_duplicate(ModuleName), Para, []) :-\n Para = p_words(\"The import of\") ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(ModuleName))] ++ p_spc_nl ++\n p_words(\"is redundant, this module is already imported\").\n\nce_to_pretty(_, ce_function_already_defined(Name), Para, []) :-\n Para = p_words(\"Function already defined:\") ++ p_spc_nl ++\n [p_str(Name)].\nce_to_pretty(_, ce_entry_function_wrong_signature, Para, []) :-\n Para = p_words(\"A function that is marked as an entrypoint does not \" ++\n \"have the correct signature for an entrypoint.\").\n\nce_to_pretty(_, ce_type_already_defined(Name), Para, []) :-\n Para = p_words(\"Type already defined: \") ++ p_spc_nl ++\n [q_name_pretty(Name)].\nce_to_pretty(_, ce_type_duplicate_constructor(Name), Para, []) :-\n Para = p_words(\"This type already has a constructor named\") ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(Name))].\nce_to_pretty(_, ce_type_not_known(Name), Para, []) :-\n Para = p_words(\"Unknown type:\") ++ p_spc_nl ++\n [q_name_pretty(Name)].\nce_to_pretty(_, ce_type_not_public_in_type(Referer, Referee), Para, []) :-\n Para = p_words(\"The type\") ++ p_spc_nl ++\n [nq_name_pretty(Referer)] ++ p_spc_nl ++\n p_words(\"is exported, but it refers to another type\") ++ p_spc_nl ++\n [nq_name_pretty(Referee)] ++ p_spc_nl ++\n p_words(\"which is not.\").\nce_to_pretty(_, ce_type_not_public_in_func(Func, Type), Para, []) :-\n Para = p_words(\"The function\") ++ p_spc_nl ++\n [nq_name_pretty(Func)] ++ p_spc_nl ++\n p_words(\"is exported, but it refers to the type\") ++ p_spc_nl ++\n [nq_name_pretty(Type)] ++ p_spc_nl ++\n p_words(\"which is not.\").\nce_to_pretty(_, ce_type_var_unknown(Name), Para, []) :-\n Para = p_words(\"Type variable\") ++ p_spc_nl ++\n [p_quote(\"'\", p_str(Name))] ++ p_spc_nl ++\n p_words(\"does not appear on left of '=' in type definition\").\nce_to_pretty(_, ce_type_has_incorrect_num_of_args(Name, Want, Got), Para, []) :-\n Para = p_words(\"Wrong number of type args for \") ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(Name)), p_str(\",\")] ++ p_spc_nl ++\n [p_str(\"expected: \"), p_str(string(Want)), p_str(\",\")] ++ p_spc_nl ++\n [p_str(\"got: \"), p_str(string(Got))].\nce_to_pretty(_, ce_builtin_type_with_args(Name), Para, []) :-\n Para = p_words(\"Builtin type\") ++ p_spc_nl ++\n [p_quote(\"'\", q_name_pretty(Name))] ++ p_spc_nl ++\n p_words(\"does not take arguments\").\nce_to_pretty(_, ce_type_var_with_args(Name), Para, []) :-\n Para = p_words(\"Type variables (like\") ++ p_spc_nl ++\n [p_quote(\"'\", p_str(Name))] ++ p_spc_nl ++\n p_words(\"cannot take arguments\").\nce_to_pretty(_, ce_type_error(TypeError), Para, []) :-\n Para = type_error_pretty(TypeError).\nce_to_pretty(_, ce_type_floundering(Vars, Clauses), Para, Extra) :-\n Para = p_words(\"Ambigious types\"),\n Extra = [\n p_expr([p_str(\"The unbound solver variables are: \"), p_nl_hard,\n p_list(pretty_seperated([p_nl_hard], Vars))]), p_nl_double,\n p_expr([p_str(\"The unresolved solver clauses are: \"), p_nl_hard,\n p_list(pretty_seperated([p_nl_double], Clauses))])].\n\nce_to_pretty(_, ce_match_has_no_cases,\n p_words(\"Match expression has no cases\"), []).\nce_to_pretty(_, ce_match_does_not_cover_all_cases,\n p_words(\"Match does not cover all cases\"), []).\nce_to_pretty(_, ce_match_unreached_cases,\n p_words(\"This case will never be tested because earlier cases cover \" ++\n \"all values\"),\n []).\nce_to_pretty(_, ce_match_duplicate_case,\n p_words(\"This case occurs multiple times in this match\"), []).\nce_to_pretty(_, ce_match_on_function_type,\n p_words(\"Attempt to pattern match on a function\"), []).\nce_to_pretty(_, ce_case_does_not_define_all_variables(Vars),\n p_words(\"This branch did not initialise variables initialised on other\n branches, they are:\") ++\n [p_nl_soft, p_str(\" \"),\n p_list(pretty_seperated([p_str(\", \"), p_nl_soft],\n map(p_str, Vars)))], []).\n\nce_to_pretty(_, Error, Pretty, []) :-\n % These to errors are broken and can't be properly distinguished.\n ( Error = ce_arity_mismatch_func(Got, Expect)\n ; Error = ce_arity_mismatch_expr(Got, Expect)\n ),\n Pretty = p_words(format(\n \"Arity error got %d values, but %d values were expected\",\n [i(Got ^ a_num), i(Expect ^ a_num)])).\n%ce_to_pretty(ce_arity_mismatch_func(Decl, Infer)) =\n% format(\"Function has %d declared results but returns %d results\",\n% [i(Decl ^ a_num), i(Infer ^ a_num)]).\n%ce_to_pretty(ce_arity_mismatch_expr(Got, Expect)) =\n% format(\"Expression returns %d values, but %d values were expected\",\n% [i(Got ^ a_num), i(Expect ^ a_num)]).\nce_to_pretty(_, ce_arity_mismatch_tuple,\n p_words(\"Arity mismatch in tuple, could be called by arguments to call\"),\n []).\nce_to_pretty(_, ce_arity_mismatch_match(Arities), Para, []) :-\n Para = p_words(\"Match expression has cases with different arrites, \" ++\n \" they are:\") ++\n p_spc_nl ++ [p_expr(pretty_comma_seperated(\n map((func(MA) = S :-\n ( MA = yes(A), S = p_str(string(A ^ a_num))\n ; MA = no, S = p_str(\"_\")\n )\n ), Arities)\n ))].\n\nce_to_pretty(_, ce_parameter_number(Exp, Got), Para, []) :-\n Para = p_words(format(\"Wrong number of parameters in function call, \"\n ++ \"expected %d got %d\",\n [i(Exp), i(Got)])).\nce_to_pretty(_, ce_no_return_statement(Arity), Para, []) :-\n Para = p_words(format(\n \"Function returns %d results but this path has no return statement\",\n [i(Arity ^ a_num)])).\n\nce_to_pretty(_, ce_uses_observes_not_distinct(Resources), Para, []) :-\n Para = p_words(\"A resource cannot appear in both the uses and observes \" ++\n \"lists, found resources:\") ++\n p_spc_nl ++\n pretty_comma_seperated(map(func(R) = p_str(resource_to_string(R)),\n Resources)).\nce_to_pretty(_, ce_resource_unavailable_call,\n p_words(\"One or more resources needed for this call is unavailable \" ++\n \"in this function\"),\n []).\nce_to_pretty(_, ce_resource_unavailable_arg,\n p_words(\"One or more resources needed for an argument to a call \" ++\n \"is not provided in by the passed-in value\"),\n []).\nce_to_pretty(_, ce_resource_unavailable_output,\n p_words(\"The function returns a higher order value that uses or \" ++\n \"observes one or more resources, however the resources arn't \" ++\n \"declared in the function's return type\"),\n []).\nce_to_pretty(_, ce_resource_unknown(Res),\n p_words(\"Unknown resource\") ++\n p_spc_nl ++ [p_quote(\"'\", q_name_pretty(Res))],\n []).\nce_to_pretty(_, ce_resource_not_public_in_resource(Res, From), Para, []) :-\n Para = p_words(\"The resource\") ++\n p_spc_nl ++ [nq_name_pretty(Res)] ++ p_spc_nl ++\n p_words(\"is exported, but it depends on\") ++\n p_spc_nl ++ [nq_name_pretty(From)] ++ p_spc_nl ++\n p_words(\"which is not\").\nce_to_pretty(_, ce_resource_not_public_in_type(Type, Res), Para, []) :-\n Para = p_words(\"The type\") ++\n p_spc_nl ++ [nq_name_pretty(Type)] ++ p_spc_nl ++\n p_words(\"is exported, but it refers to the resource\") ++ p_spc_nl ++\n [nq_name_pretty(Res)] ++ p_spc_nl ++\n p_words(\"which is not exported\").\nce_to_pretty(_, ce_resource_not_public_in_function(Func, Res), Para, []) :-\n Para = p_words(\"The function\") ++\n p_spc_nl ++ [nq_name_pretty(Func)] ++ p_spc_nl ++\n p_words(\"is exported, but it refers to the resource\") ++ p_spc_nl ++\n [nq_name_pretty(Res)] ++ p_spc_nl ++\n p_words(\"which is not exported\").\nce_to_pretty(_, ce_too_many_bangs_in_statement,\n p_words(\"Statement has more than one ! call\"), []).\nce_to_pretty(_, ce_no_bang,\n p_words(\"Call uses or observes a resource but has no !\"), []).\nce_to_pretty(_, ce_unnecessary_bang,\n p_words(\"Call has a ! but does not need it\"), []).\n\nce_to_pretty(_, ce_pragma_unknown(Pragma), Para, []) :-\n Para = p_words(\"Pragma\") ++ p_spc_nl ++\n [p_quote(\"'\", p_str(Pragma))] ++ p_spc_nl ++\n p_words(\"is unrecognised and will be ignored\").\nce_to_pretty(_, ce_pragma_bad_argument, Para, []) :-\n Para = p_words(\"Unrecognised argument for this pragma\").\n\n:- func type_error_pretty(type_error) = list(pretty).\n\ntype_error_pretty(type_unification_failed(Type1, Type2, MaybeWhy)) = Error :-\n Error = [p_quote(\"\\\"\", Type1)] ++ p_spc_nl ++ [p_str(\"and\")] ++\n p_spc_nl ++ [p_quote(\"\\\"\", Type2)] ++ p_spc_nl ++\n p_words(\"are not the same\") ++ WhyError,\n ( MaybeWhy = yes(Why),\n WhyError = p_words(\", because\") ++ [p_nl_hard] ++\n type_error_pretty(Why)\n ; MaybeWhy = no,\n WhyError = []\n ).\ntype_error_pretty(type_unification_occurs(Var, Type)) =\n [p_str(\"Type error: \"),\n p_str(\"The type \"), p_quote(\"\\\"\", Var)] ++ p_spc_nl ++\n p_words(\"cannot be bound to\") ++ p_spc_nl ++\n [p_quote(\"\\\"\", Type)] ++ p_spc_nl ++\n p_words(\"because it can't contain itself.\").\n\n:- func p_file(string, filename) = list(pretty).\n\np_file(SourcePath, filename(File0)) = [p_quote(\"'\", p_str(File))] :-\n ( if append(SourcePath, File1, File0) then\n File = File1\n else\n File = File0\n ).\n\n%-----------------------------------------------------------------------%\n" }, { "path": "src/constant.m", "content": "%-----------------------------------------------------------------------%\n% Plasma constants\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module provides constants used in the compiler and other tools.\n%\n%-----------------------------------------------------------------------%\n:- module constant.\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module io.\n\n:- func source_extension = string.\n:- func typeres_extension = string.\n:- func interface_extension = string.\n:- func depends_extension = string.\n:- func pz_text_extension = string.\n:- func output_extension = string.\n:- func library_extension = string.\n\n:- func native_object_extension = string.\n:- func native_dylib_extension = string.\n:- func cpp_extension = string.\n:- func c_header_extension = string.\n\n:- func build_file = string.\n:- func build_directory = string.\n:- func ninja_rules_file = string.\n:- func ninja_vars_file = string.\n:- func ninja_build_file = string.\n:- func import_whitelist_file_no_directroy = string.\n\n%-----------------------------------------------------------------------%\n\n:- func version_string = string.\n\n % Print the version message.\n %\n:- pred version(string::in, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module list.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\nsource_extension = \".p\".\ntyperes_extension = \".typeres\".\ninterface_extension = \".pi\".\ndepends_extension = \".dep\".\npz_text_extension = \".pzt\".\noutput_extension = \".pzo\".\nlibrary_extension = \".pz\".\n\nnative_object_extension = \".o\".\nnative_dylib_extension = \".so\".\ncpp_extension = \".cpp\".\nc_header_extension = \".h\".\n\nbuild_file = \"BUILD.plz\".\nbuild_directory = \"_build\".\nninja_rules_file = \"rules.ninja\".\nninja_vars_file = \"vars.ninja\".\nninja_build_file = \"build.ninja\".\n% Ninja requires it uses this name.\nimport_whitelist_file_no_directroy = \"include_whitelist.txt\".\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_decl(\"C\", include_file(\"../runtime/pz_config.h\")).\n\n:- pragma foreign_proc(\"C\",\n version_string = (Version::out),\n [promise_pure, thread_safe, will_not_call_mercury,\n will_not_throw_exception],\n \"\n Version = GC_STRDUP(PLASMA_VERSION_STRING);\n \").\n\nversion(Name, !IO) :-\n io.format(\"%s, %s\\n\", [s(Name), s(version_string)], !IO),\n io.write_string(\"https://plasmalang.org\\n\", !IO),\n io.write_string(\"Copyright (C) 2015-2025 The Plasma Team\\n\", !IO),\n io.write_string(\"Distributed under the MIT License\\n\", !IO).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/context.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module context.\n%\n% A location in a source file\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\n:- type context\n ---> context(\n c_file :: string,\n c_line :: int,\n c_col :: int\n ).\n\n:- func context(string) = context.\n\n:- func context(string, int) = context.\n\n%-----------------------------------------------------------------------%\n\n:- func nil_context = context.\n:- pred is_nil_context(context::in) is semidet.\n\n:- func builtin_context = context.\n\n:- func command_line_context = context.\n\n:- func context_string(context) = string.\n\n % context_string(SourcePath, Context) = Pretty.\n %\n % Print the context but with the initial SourcePath removed.\n %\n:- func context_string(string, context) = string.\n\n%-----------------------------------------------------------------------%\n\n:- func context_earliest(context, context) = context.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module list.\n\n%-----------------------------------------------------------------------%\n\ncontext(Name) = context(Name, 0, 0).\n\ncontext(Name, Line) = context(Name, Line, 0).\n\n%-----------------------------------------------------------------------%\n\nnil_context = context(\"\").\n\nis_nil_context(context(\"\", _, _)).\n\nbuiltin_context = context(\"builtin\").\n\ncommand_line_context = context(\"Command line\").\n\n%-----------------------------------------------------------------------%\n\ncontext_string(Context) =\n context_string(\"\", Context).\n\n% We do not print the character information, I'm pretty sure that they're\n% inaccurate because whitespace is not included in their calculation (see\n% the tokenize and tokenize_line predicates). But we still store them to\n% make comparing contexts feasible.\ncontext_string(SourcePath, context(File0, Line, _)) = Pretty :-\n ( if append(SourcePath, File1, File0) then\n File = File1\n else\n File = File0\n ),\n ( if Line = 0 then\n Pretty = File\n else\n Pretty = format(\"%s:%d\", [s(File), i(Line)])\n ).\n\n%-----------------------------------------------------------------------%\n\ncontext_earliest(C1, C2) = ( if compare((<), C1, C2) then C1 else C2 ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.arity_chk.m", "content": "%-----------------------------------------------------------------------%\n% Plasma arity checking\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT see ../LICENSE.code\n%\n% Annotate each expression with its arity (the number of things it returns).\n%\n%-----------------------------------------------------------------------%\n:- module core.arity_chk.\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module io.\n\n:- import_module util.log.\n:- import_module util.result.\n:- import_module compile_error.\n\n%-----------------------------------------------------------------------%\n\n:- pred arity_check(log_config::in, errors(compile_error)::out,\n core::in, core::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module require.\n\n:- import_module core.util.\n\n%-----------------------------------------------------------------------%\n\narity_check(Verbose, Errors, !Core, !IO) :-\n process_noerror_funcs(Verbose, compute_arity_func, Errors, !Core, !IO).\n\n:- pred compute_arity_func(core::in, Unused::in, function::in,\n result_partial(function, compile_error)::out) is det.\n\ncompute_arity_func(Core, _, Func0, Result) :-\n func_get_type_signature(Func0, _, _, DeclaredArity),\n ( if func_get_body(Func0, Varmap, Args, Captured, Expr0) then\n compute_arity_expr(Core, Expr0, Expr1, ArityResult),\n ( ArityResult = ok(yes(Arity)),\n Origin = code_info_origin(Expr1 ^ e_info),\n ( if Arity = DeclaredArity then\n func_set_body(Varmap, Args, Captured, Expr1, Func0, Func),\n Result = ok(Func, init)\n else if Origin = o_user_return(_) then\n Result = errors(error(func_get_context(Func0),\n ce_arity_mismatch_func(DeclaredArity, Arity)))\n else\n Result = errors(error(code_info_context(Expr1 ^ e_info),\n ce_arity_mismatch_expr(Arity, DeclaredArity)))\n )\n ; ArityResult = ok(no),\n push_arity_into_expr(DeclaredArity, Expr1, Expr),\n func_set_body(Varmap, Args, Captured, Expr, Func0, Func),\n Result = ok(Func, init)\n ; ArityResult = errors(Errors),\n Result = errors(Errors)\n )\n else\n unexpected($file, $pred, \"Imported function\")\n ).\n\n:- pred compute_arity_expr(core::in, expr::in, expr::out,\n result(maybe(arity), compile_error)::out) is det.\n\ncompute_arity_expr(Core, expr(ExprType0, CodeInfo0), expr(ExprType, CodeInfo),\n Result) :-\n ( ExprType0 = e_tuple(Exprs0),\n ( if Exprs0 = [Expr0] then\n % Arity checking is easier without singleton tuples, simplify them\n % now (the real simplification pass happens after arity\n % checking).\n compute_arity_expr(Core, Expr0, expr(ExprType, CodeInfo), Result)\n else\n compute_arity_expr_tuple(Core, Exprs0, Exprs, CodeInfo0, CodeInfo,\n Result),\n ExprType = e_tuple(Exprs)\n )\n ; ExprType0 = e_lets(Lets0, Expr0),\n compute_arity_expr_lets(Core, Lets0, Lets, Expr0, Expr, CodeInfo0,\n CodeInfo, Result),\n ExprType = e_lets(Lets, Expr)\n ; ExprType0 = e_call(Callee, Args, MaybeResources),\n ExprType = e_call(Callee, Args, MaybeResources),\n compute_arity_expr_call(Core, Callee, Args, CodeInfo0, CodeInfo,\n Result)\n ; ExprType0 = e_match(Var, Cases0),\n compute_arity_expr_match(Core, Cases0, Cases, CodeInfo0, CodeInfo,\n Result),\n ExprType = e_match(Var, Cases)\n ;\n ( ExprType0 = e_var(_)\n ; ExprType0 = e_constant(_)\n ; ExprType0 = e_construction(_, _)\n ; ExprType0 = e_closure(_, _)\n ),\n Arity = arity(1),\n code_info_set_arity(Arity, CodeInfo0, CodeInfo),\n ExprType = ExprType0,\n Result = ok(yes(Arity))\n ).\n\n:- pred compute_arity_expr_tuple(core::in, list(expr)::in, list(expr)::out,\n code_info::in, code_info::out, result(maybe(arity), compile_error)::out)\n is det.\n\ncompute_arity_expr_tuple(Core, !Exprs, !CodeInfo, Result) :-\n map2(compute_arity_expr_in_tuple(Core), !Exprs, TupleErrorss),\n Arity = arity(length(!.Exprs)),\n code_info_set_arity(Arity, !CodeInfo),\n\n TupleErrors = cord_list_to_cord(TupleErrorss),\n ( if is_empty(TupleErrors) then\n Result = ok(yes(Arity))\n else\n Result = errors(TupleErrors)\n ).\n\n:- pred compute_arity_expr_in_tuple(core::in, expr::in, expr::out,\n errors(compile_error)::out) is det.\n\ncompute_arity_expr_in_tuple(Core, !Expr, Errors) :-\n compute_arity_expr(Core, !Expr, Result),\n ( Result = errors(Errors)\n ; Result = ok(MaybeArity),\n ( MaybeArity = yes(Arity),\n ( if Arity = arity(1) then\n Errors = init\n else\n Errors = error(code_info_context(!.Expr ^ e_info),\n ce_arity_mismatch_tuple)\n )\n ; MaybeArity = no,\n push_arity_into_expr(arity(1), !Expr),\n Errors = init\n )\n ).\n\n:- pred compute_arity_expr_lets(core::in,\n list(expr_let)::in, list(expr_let)::out, expr::in, expr::out,\n code_info::in, code_info::out, result(maybe(arity), compile_error)::out)\n is det.\n\ncompute_arity_expr_lets(Core, Lets0, Lets, Expr0, Expr, !CodeInfo, Result) :-\n map2(compute_arity_expr_let(Core), Lets0, Lets, LetsErrors0),\n LetsErrors = cord_list_to_cord(LetsErrors0),\n compute_arity_expr(Core, Expr0, Expr, Result0),\n ( Result0 = ok(MaybeArity),\n ( if is_empty(LetsErrors) then\n ( MaybeArity = yes(Arity),\n code_info_set_arity(Arity, !CodeInfo)\n ; MaybeArity = no\n ),\n Result = Result0\n else\n Result = errors(LetsErrors)\n )\n ; Result0 = errors(Errors),\n Result = errors(LetsErrors ++ Errors)\n ).\n\n:- pred compute_arity_expr_let(core::in, expr_let::in, expr_let::out,\n errors(compile_error)::out) is det.\n\ncompute_arity_expr_let(Core, e_let(Vars, Expr0), e_let(Vars, Expr), Result) :-\n compute_arity_expr(Core, Expr0, Expr1, LetRes),\n VarsArity = arity(length(Vars)),\n ( LetRes = ok(MaybeLetArity),\n ( MaybeLetArity = yes(LetArity),\n Expr = Expr1,\n ( if VarsArity = LetArity then\n Result = init\n else\n Result = error(\n code_info_context(Expr ^ e_info),\n ce_arity_mismatch_expr(LetArity, VarsArity))\n )\n ; MaybeLetArity = no,\n push_arity_into_expr(VarsArity, Expr1, Expr),\n Result = init\n )\n ; LetRes = errors(Errors),\n Expr = Expr1,\n Result = Errors\n ).\n\n:- pred compute_arity_expr_call(core::in, callee::in, list(T)::in,\n code_info::in, code_info::out, result(maybe(arity), compile_error)::out)\n is det.\n\ncompute_arity_expr_call(Core, Callee, Args, !CodeInfo, Result) :-\n ( Callee = c_plain(FuncId),\n core_get_function_det(Core, FuncId, CalleeFn),\n func_get_type_signature(CalleeFn, Inputs, _, Arity),\n length(Inputs, InputsLen),\n length(Args, ArgsLen),\n ( if InputsLen = ArgsLen then\n InputErrors = init\n else\n InputErrors = error(code_info_context(!.CodeInfo),\n ce_parameter_number(length(Inputs), length(Args)))\n ),\n code_info_set_arity(Arity, !CodeInfo),\n ( if is_empty(InputErrors) then\n Result = ok(yes(Arity))\n else\n Result = errors(InputErrors)\n )\n ; Callee = c_ho(_),\n Result = ok(no)\n ).\n\n:- pred compute_arity_expr_match(core::in, list(expr_case)::in,\n list(expr_case)::out, code_info::in, code_info::out,\n result(maybe(arity), compile_error)::out) is det.\n\ncompute_arity_expr_match(Core, !Cases, !CodeInfo, Result) :-\n Context = code_info_context(!.CodeInfo),\n map2(compute_arity_case(Core), !Cases, CaseResults),\n Result0 = result_list_to_result(CaseResults),\n ( Result0 = ok(CaseArities),\n filter_map((pred(yes(A)::in, A::out) is semidet), CaseArities,\n KnownCaseArities),\n (\n KnownCaseArities = [],\n Result = ok(no)\n ;\n KnownCaseArities = [Arity | _],\n ( if all_same(KnownCaseArities) then\n code_info_set_arity(Arity, !CodeInfo),\n map(update_arity_case(Arity), !Cases),\n Result = ok(yes(Arity))\n else\n Result = return_error(Context,\n ce_arity_mismatch_match(CaseArities))\n )\n )\n ; Result0 = errors(Errors),\n Result = errors(Errors)\n ).\n\n:- pred compute_arity_case(core::in, expr_case::in, expr_case::out,\n result(maybe(arity), compile_error)::out) is det.\n\ncompute_arity_case(Core, e_case(Pat, Expr0), e_case(Pat, Expr), Result) :-\n compute_arity_expr(Core, Expr0, Expr, Result).\n\n:- pred update_arity_case(arity::in, expr_case::in, expr_case::out) is det.\n\nupdate_arity_case(Arity, e_case(Pat, Expr0), e_case(Pat, Expr)) :-\n CodeInfo0 = Expr0 ^ e_info,\n ( if code_info_arity(CodeInfo0, _Arity0) then\n Expr = Expr0\n else\n push_arity_into_expr(Arity, Expr0, Expr)\n ).\n\n:- pred push_arity_into_expr(arity::in, expr::in, expr::out) is det.\n\npush_arity_into_expr(Arity, !Expr) :-\n some [!CodeInfo] (\n !:CodeInfo = !.Expr ^ e_info,\n ( if not code_info_arity(!.CodeInfo, _) then\n code_info_set_arity(Arity, !CodeInfo),\n !Expr ^ e_info := !.CodeInfo,\n some [!EType] (\n !:EType = !.Expr ^ e_type,\n ( !.EType = e_lets(Lets, Expr0),\n push_arity_into_expr(Arity, Expr0, Expr),\n !:EType = e_lets(Lets, Expr)\n ; !.EType = e_call(_, _, _)\n ; !.EType = e_match(Var, Cases0),\n Cases = map((func(e_case(Pat, E0)) = e_case(Pat, E) :-\n push_arity_into_expr(Arity, E0, E)\n ), Cases0),\n !:EType = e_match(Var, Cases)\n ;\n ( !.EType = e_tuple(_)\n ; !.EType = e_var(_)\n ; !.EType = e_constant(_)\n ; !.EType = e_construction(_, _)\n ; !.EType = e_closure(_, _)\n ),\n unexpected($file, $pred,\n \"This expression should already have an arity\")\n ),\n !Expr ^ e_type := !.EType\n )\n else\n true\n )\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.branch_chk.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core.branch_chk.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT see ../LICENSE.code\n%\n% Plasma branch checking.\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n\n:- import_module compile_error.\n:- import_module util.log.\n:- import_module util.result.\n\n:- pred branch_check(log_config::in, errors(compile_error)::out,\n core::in, core::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module require.\n\n:- import_module context.\n:- import_module core.util.\n:- import_module util.mercury.\n\n%-----------------------------------------------------------------------%\n\nbranch_check(Verbose, Errors, !Core, !IO) :-\n process_noerror_funcs(Verbose, branchcheck_func, Errors, !Core, !IO).\n\n:- pred branchcheck_func(core::in, func_id::in, function::in,\n result_partial(function, compile_error)::out) is det.\n\nbranchcheck_func(Core, _FuncId, Func, Result) :-\n ( if\n func_get_body(Func, _, _, _, Expr),\n func_get_vartypes(Func, Vartypes)\n then\n Errors = branchcheck_expr(Core, Vartypes, Expr),\n ( if not has_fatal_errors(Errors) then\n Result = ok(Func, Errors)\n else\n Result = errors(Errors)\n )\n else\n unexpected($file, $pred, \"Function body or types not present\")\n ).\n\n:- func branchcheck_expr(core, map(var, type_), expr) = errors(compile_error).\n\nbranchcheck_expr(Core, Vartypes, expr(ExprType, CodeInfo)) = Errors :-\n ( ExprType = e_tuple(Exprs),\n Errors = cord_list_to_cord(map(branchcheck_expr(Core, Vartypes), Exprs))\n ; ExprType = e_lets(Lets, Expr),\n Errors =\n cord_list_to_cord(map(branchcheck_let(Core, Vartypes), Lets)) ++\n branchcheck_expr(Core, Vartypes, Expr)\n ;\n ( ExprType = e_call(_, _, _)\n ; ExprType = e_var(_)\n ; ExprType = e_constant(_)\n ; ExprType = e_construction(_, _)\n ; ExprType = e_closure(_, _)\n ),\n Errors = init\n ; ExprType = e_match(Var, Cases),\n map.lookup(Vartypes, Var, Type),\n Context = code_info_context(CodeInfo),\n Errors = branchcheck_match(Core, Context, Type, Cases)\n ).\n\n:- func branchcheck_let(core, map(var, type_), expr_let) =\n errors(compile_error).\n\nbranchcheck_let(Core, Vartypes, e_let(_, Expr)) =\n branchcheck_expr(Core, Vartypes, Expr).\n\n:- func branchcheck_match(core, context, type_, list(expr_case)) =\n errors(compile_error).\n\nbranchcheck_match(Core, Context, Type, Cases) = Errors :-\n ( Type = builtin_type(Builtin),\n % Int and string have an infinite number of values. Their pattern\n % matches must contain at least one wildcard.\n (\n ( Builtin = int\n ; Builtin = string\n ; Builtin = codepoint\n )\n ; Builtin = string_pos,\n unexpected($file, $pred, \"Match on opaque builtin\")\n ),\n Errors = branchcheck_inf(Context, Cases, set.init)\n ; Type = type_ref(TypeId, _),\n MaybeCtors = utype_get_ctors(core_get_type(Core, TypeId)),\n ( MaybeCtors = yes(CtorsList),\n Ctors = list_to_set(CtorsList)\n ; MaybeCtors = no,\n unexpected($file, $pred, \"Pattern match on abstract type\")\n ),\n Errors = branchcheck_type(Context, Ctors, Cases)\n ; Type = type_variable(_),\n unexpected($file, $pred, \"Type variable in match\")\n ; Type = func_type(_, _, _, _),\n Errors = error(Context, ce_match_on_function_type)\n ).\n\n:- func branchcheck_inf(context, list(expr_case), set(int)) =\n errors(compile_error).\n\nbranchcheck_inf(Context, [], _) =\n error(Context, ce_match_does_not_cover_all_cases).\nbranchcheck_inf(Context, [e_case(Pat, Expr) | Cases], SeenSet0) = Errors :-\n ( Pat = p_num(Num),\n ( if insert_new(Num, SeenSet0, SeenSet) then\n Errors = branchcheck_inf(Context, Cases, SeenSet)\n else\n Errors = error(code_info_context(Expr ^ e_info),\n ce_match_duplicate_case) ++\n branchcheck_inf(Context, Cases, SeenSet0)\n )\n ;\n ( Pat = p_variable(_)\n ; Pat = p_wildcard\n ),\n Errors = branchcheck_tail(Cases)\n ; Pat = p_ctor(_, _),\n unexpected($file, $pred, \"Constructor seen on builtin type match\")\n ).\n\n:- func branchcheck_type(context, set(ctor_id), list(expr_case)) =\n errors(compile_error).\n\nbranchcheck_type(Context, TypeCtors, []) =\n ( if is_empty(TypeCtors) then\n init\n else\n error(Context, ce_match_does_not_cover_all_cases)\n ).\nbranchcheck_type(Context, TypeCtors, [e_case(Pat, Expr) | Cases]) = Errors :-\n ( if is_empty(TypeCtors) then\n Errors = error(code_info_context(Expr ^ e_info),\n ce_match_unreached_cases)\n else\n ( Pat = p_num(_),\n unexpected($file, $pred, \"Number seen on user type match\")\n ;\n ( Pat = p_variable(_)\n ; Pat = p_wildcard\n ),\n Errors = branchcheck_tail(Cases)\n ; Pat = p_ctor(Ctors, _),\n % There should be only one constructor here because typechecking\n % would have made it unambigious.\n Ctor = one_item_in_set(Ctors),\n ( if remove(Ctor, TypeCtors, RestCtors) then\n Errors = branchcheck_type(Context, RestCtors, Cases)\n else\n % The only way remove can fail when the program is type\n % correct is if there is a duplicate case.\n Errors = error(code_info_context(Expr ^ e_info),\n ce_match_duplicate_case) ++\n branchcheck_type(Context, TypeCtors, Cases)\n )\n )\n ).\n\n:- func branchcheck_tail(list(expr_case)) = errors(compile_error).\n\nbranchcheck_tail([]) = init.\nbranchcheck_tail([e_case(_, expr(_, CodeInfo)) | _]) =\n error(code_info_context(CodeInfo), ce_match_unreached_cases).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.code.m", "content": "%-----------------------------------------------------------------------%\n% Plasma code representation\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module core.code.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module context.\n:- import_module common_types.\n\n%-----------------------------------------------------------------------%\n\n:- type expr\n ---> expr(\n e_type :: expr_type,\n e_info :: code_info\n ).\n\n:- type expr_type\n ---> e_tuple(list(expr))\n ; e_lets(list(expr_let), expr)\n ; e_call(callee, list(var), maybe_resources)\n ; e_var(var)\n ; e_constant(const_type)\n % A constructon of one of the possible constructors. After\n % successful type checking this set contains exactly one item.\n ; e_construction(set(ctor_id), list(var))\n ; e_closure(func_id, list(var))\n ; e_match(var, list(expr_case)).\n\n% All expressions must be matched with a variable or otherwise the root of a\n% function. The typechecker uses this property to attach types to each\n% variable and therefore all expressions will have types. Therefore we\n% cannot allow an expression to bind no variables (except the empty tuple\n% expression which has no type). Similarly we cannot cast arity. Instead\n% some variables are bound but never used.\n:- type expr_let\n ---> e_let(list(var), expr).\n\n:- type expr_case\n ---> e_case(expr_pattern, expr).\n\n:- type expr_pattern\n ---> p_num(int)\n ; p_variable(var)\n ; p_wildcard\n ; p_ctor(set(ctor_id), list(var)).\n\n:- type callee\n ---> c_plain(func_id)\n ; c_ho(var).\n\n%-----------------------------------------------------------------------%\n\n:- type code_info.\n\n:- type code_origin\n ---> o_user_body(context)\n ; o_user_decl(context)\n ; o_user_return(context)\n ; o_builtin\n ; o_introduced.\n\n:- func code_info_init(code_origin) = code_info.\n\n:- type bang_marker\n ---> has_bang_marker\n ; no_bang_marker.\n\n:- func code_info_context(code_info) = context.\n\n:- func code_info_origin(code_info) = code_origin.\n\n:- pred code_info_set_origin(code_origin::in,\n code_info::in, code_info::out) is det.\n\n:- func code_info_bang_marker(code_info) = bang_marker.\n\n:- pred code_info_set_bang_marker(bang_marker::in,\n code_info::in, code_info::out) is det.\n\n:- pred code_info_arity(code_info::in, arity::out) is semidet.\n\n % Throws an exception if the arity has not been set.\n %\n:- func code_info_arity_det(code_info) = arity.\n\n:- pred code_info_set_arity(arity::in, code_info::in, code_info::out) is det.\n\n:- func code_info_types(code_info) = list(type_).\n\n:- func code_info_maybe_types(code_info) = maybe(list(type_)).\n\n:- pred code_info_set_types(list(type_)::in, code_info::in, code_info::out)\n is det.\n\n % Merge to code_infos, The context of the first overrides the 2nd,\n % while the types and arity (result information) of the 2nd overrides\n % the first. This is suitable for composing let expressions from two\n % other expressions' code_infos.\n %\n:- func code_info_join(code_info, code_info) = code_info.\n\n%-----------------------------------------------------------------------%\n\n:- func expr_get_callees(expr) = set(func_id).\n\n%-----------------------------------------------------------------------%\n\n:- pred insert_result_expr(expr::in, expr::in, expr::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- pred make_renaming(set(var)::in, map(var, var)::out,\n varmap::in, varmap::out) is det.\n\n:- pred rename_expr(map(var, var)::in, expr::in, expr::out) is det.\n\n:- pred rename_pattern(map(var, var)::in, expr_pattern::in, expr_pattern::out)\n is det.\n\n:- pred expr_make_vars_unique(expr::in, expr::out,\n set(var)::in, set(var)::out, varmap::in, varmap::out) is det.\n\n:- pred expr_has_branch(expr::in) is semidet.\n\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module string.\n:- import_module require.\n\n%-----------------------------------------------------------------------%\n\n:- type code_info\n ---> code_info(\n ci_origin :: code_origin,\n\n ci_bang_marker :: bang_marker,\n\n % How many results does this expression return?\n ci_arity :: maybe(arity),\n\n % The type of each result\n ci_types :: maybe(list(type_))\n ).\n\ncode_info_init(Origin) = code_info(Origin, no_bang_marker, no, no).\n\ncode_info_context(Info) = Context :-\n Origin = Info ^ ci_origin,\n ( if origin_context(Origin, ContextP) then\n Context = ContextP\n else\n Context = nil_context\n ).\n\ncode_info_origin(Info) = Info ^ ci_origin.\n\ncode_info_set_origin(Origin, !Info) :-\n !Info ^ ci_origin := Origin.\n\ncode_info_bang_marker(Info) = Info ^ ci_bang_marker.\n\ncode_info_set_bang_marker(BangMarker, !Info) :-\n !Info ^ ci_bang_marker := BangMarker.\n\ncode_info_arity(Info, Arity) :-\n yes(Arity) = Info ^ ci_arity.\n\ncode_info_arity_det(Info) = Arity :-\n ( if code_info_arity(Info, ArityP) then\n Arity = ArityP\n else\n unexpected($file, $pred, \"Arity has not been set, \" ++\n \"typechecking must execute before expression arity is known\")\n ).\n\ncode_info_set_arity(Arity, !Info) :-\n !Info ^ ci_arity := yes(Arity).\n\ncode_info_types(Info) = Types :-\n MaybeTypes = Info ^ ci_types,\n ( MaybeTypes = yes(Types)\n ; MaybeTypes = no,\n unexpected($file, $pred, \"Types unknown\")\n ).\n\ncode_info_maybe_types(Info) = Info ^ ci_types.\n\ncode_info_set_types(Types, !Info) :-\n !Info ^ ci_types := yes(Types).\n\n%-----------------------------------------------------------------------%\n\ncode_info_join(CIA, CIB) = CI :-\n ( if\n ( CIA ^ ci_bang_marker = has_bang_marker\n ; CIB ^ ci_bang_marker = has_bang_marker\n )\n then\n Bang = has_bang_marker\n else\n Bang = no_bang_marker\n ),\n Arity = CIB ^ ci_arity,\n Types = CIB ^ ci_types,\n Origin = origin_join(CIA ^ ci_origin, CIB ^ ci_origin),\n CI = code_info(Origin, Bang, Arity, Types).\n\n:- func origin_join(code_origin, code_origin) = code_origin.\n\norigin_join(O@o_user_body(_), _) = O.\norigin_join(O1@o_user_decl(_), O2) = O :-\n ( if O2 = o_user_body(_) then\n O = O2\n else if origin_context(O2, C) then\n O = o_user_body(C)\n else\n O = O1\n ).\norigin_join(O1@o_user_return(_), O2) = O :-\n ( if\n ( O2 = o_user_body(_)\n ; O2 = o_user_decl(_)\n )\n then\n O = O2\n else if origin_context(O2, C) then\n O = o_user_return(C)\n else\n O = O1\n ).\norigin_join(o_builtin, O2) = O :-\n ( if O2 = o_introduced then\n O = o_builtin\n else\n O = O2\n ).\norigin_join(o_introduced, O) = O.\n\n:- pred origin_context(code_origin::in, context::out) is semidet.\n\norigin_context(Origin, Context) :-\n require_complete_switch [Origin]\n ( Origin = o_user_body(Context)\n ; Origin = o_user_decl(Context)\n ; Origin = o_user_return(Context)\n ; Origin = o_builtin,\n Context = builtin_context\n ; Origin = o_introduced,\n fail\n ).\n\n%-----------------------------------------------------------------------%\n\nexpr_get_callees(Expr) = Callees :-\n ExprType = Expr ^ e_type,\n ( ExprType = e_tuple(Exprs),\n Callees = union_list(map(expr_get_callees, Exprs))\n ; ExprType = e_lets(Lets, InExpr),\n Callees = union_list(\n map(func(e_let(_, E)) = expr_get_callees(E), Lets))\n `union` expr_get_callees(InExpr)\n ; ExprType = e_call(Callee, _, _),\n ( Callee = c_plain(FuncId),\n Callees = make_singleton_set(FuncId)\n ; Callee = c_ho(_),\n Callees = init\n )\n ; ExprType = e_var(_),\n Callees = init\n ; ExprType = e_constant(Const),\n ( Const = c_func(Callee),\n % For the purposes of compiler analysis like typechecking this is a\n % callee.\n Callees = make_singleton_set(Callee)\n ;\n ( Const = c_number(_)\n ; Const = c_string(_)\n ;\n % XXX: This could be a problem if constructors can be used\n % as functions (in higher-order contexts)\n Const = c_ctor(_)\n ),\n Callees = init\n )\n ; ExprType = e_construction(_, _),\n Callees = set.init\n ; ExprType = e_closure(Callee, _),\n Callees = make_singleton_set(Callee)\n ; ExprType = e_match(_, Cases),\n Callees = union_list(map(case_get_callees, Cases))\n ).\n\n:- func case_get_callees(expr_case) = set(func_id).\n\ncase_get_callees(e_case(_, Expr)) = expr_get_callees(Expr).\n\n%-----------------------------------------------------------------------%\n\ninsert_result_expr(LastExpr, Expr0, Expr) :-\n ExprType = Expr0 ^ e_type,\n (\n ( ExprType = e_call(_, _, _)\n ; ExprType = e_var(_)\n ; ExprType = e_constant(_)\n ; ExprType = e_construction(_, _)\n ; ExprType = e_closure(_, _)\n ),\n Expr = expr(e_lets([e_let([], Expr0)], LastExpr),\n code_info_join(Expr0 ^ e_info, LastExpr ^ e_info))\n ; ExprType = e_tuple(Exprs),\n ( Exprs = [_ | _],\n Expr = expr(e_lets([e_let([], Expr0)], LastExpr),\n code_info_join(Expr0 ^ e_info, LastExpr ^ e_info))\n ; Exprs = [],\n Expr = LastExpr\n )\n ; ExprType = e_match(Var, Cases0),\n map(insert_result_case(LastExpr), Cases0, Cases),\n Expr = expr(e_match(Var, Cases),\n code_info_join(Expr0 ^ e_info, LastExpr ^ e_info))\n\n ; ExprType = e_lets(Lets, InExpr0),\n insert_result_expr(LastExpr, InExpr0, InExpr),\n Expr = expr(e_lets(Lets, InExpr),\n code_info_join(Expr0 ^ e_info, InExpr ^ e_info))\n ).\n\n:- pred insert_result_case(expr::in, expr_case::in, expr_case::out) is det.\n\ninsert_result_case(LastExpr, e_case(Pat, Expr0), e_case(Pat, Expr)) :-\n insert_result_expr(LastExpr, Expr0, Expr).\n\n%-----------------------------------------------------------------------%\n\nmake_renaming(Vars, Renaming, !Varset) :-\n foldl2(make_renaming_var, Vars, map.init, Renaming, !Varset).\n\n:- pred make_renaming_var(var::in, map(var, var)::in, map(var, var)::out,\n varmap::in, varmap::out) is det.\n\nmake_renaming_var(Var0, !Renaming, !Varmap) :-\n add_fresh_var(get_var_name_no_suffix(!.Varmap, Var0), Var, !Varmap),\n det_insert(Var0, Var, !Renaming).\n\nrename_expr(Renaming, expr(ExprType0, Info), expr(ExprType, Info)) :-\n ( ExprType0 = e_tuple(Exprs0),\n map(rename_expr(Renaming), Exprs0, Exprs),\n ExprType = e_tuple(Exprs)\n ; ExprType0 = e_lets(Lets0, InExpr0),\n map(rename_let(Renaming), Lets0, Lets),\n rename_expr(Renaming, InExpr0, InExpr),\n ExprType = e_lets(Lets, InExpr)\n ; ExprType0 = e_call(Callee0, Args0, MaybeResources),\n map(rename_var(Renaming), Args0, Args),\n ( Callee0 = c_plain(_),\n Callee = Callee0\n ; Callee0 = c_ho(CalleeVar0),\n rename_var(Renaming, CalleeVar0, CalleeVar),\n Callee = c_ho(CalleeVar)\n ),\n ExprType = e_call(Callee, Args, MaybeResources)\n ; ExprType0 = e_var(Var0),\n rename_var(Renaming, Var0, Var),\n ExprType = e_var(Var)\n ; ExprType0 = e_constant(_),\n ExprType = ExprType0\n ; ExprType0 = e_construction(Constrs, Args0),\n map(rename_var(Renaming), Args0, Args),\n ExprType = e_construction(Constrs, Args)\n ; ExprType0 = e_closure(FuncId, Args0),\n map(rename_var(Renaming), Args0, Args),\n ExprType = e_closure(FuncId, Args)\n ; ExprType0 = e_match(Var0, Cases0),\n rename_var(Renaming, Var0, Var),\n map(rename_case(Renaming), Cases0, Cases),\n ExprType = e_match(Var, Cases)\n ).\n\n:- pred rename_let(map(var, var)::in, expr_let::in, expr_let::out) is det.\n\nrename_let(Renaming, e_let(Vars0, Expr0), e_let(Vars, Expr)) :-\n map(rename_var(Renaming), Vars0, Vars),\n rename_expr(Renaming, Expr0, Expr).\n\n:- pred rename_case(map(var, var)::in, expr_case::in, expr_case::out) is det.\n\nrename_case(Renaming, e_case(Pat0, Expr0), e_case(Pat, Expr)) :-\n rename_pattern(Renaming, Pat0, Pat),\n rename_expr(Renaming, Expr0, Expr).\n\n:- pred rename_var(map(var, var)::in, var::in, var::out) is det.\n\nrename_var(Renaming, Var0, Var) :-\n ( if search(Renaming, Var0, VarPrime) then\n Var = VarPrime\n else\n Var = Var0\n ).\n\n%-----------------------------------------------------------------------%\n\nrename_pattern(_, p_num(Num), p_num(Num)).\nrename_pattern(Renaming, p_variable(Var0), p_variable(Var)) :-\n rename_var(Renaming, Var0, Var).\nrename_pattern(_, p_wildcard, p_wildcard).\nrename_pattern(Renaming, p_ctor(C, Args0), p_ctor(C, Args)) :-\n map(rename_var(Renaming), Args0, Args).\n\n%-----------------------------------------------------------------------%\n\n % TODO: This is higher complexity than it needs to be. if it finds a\n % variable that needs to be renamed it will perform the rename\n % (traversing the sub-expression(s)) and then traverse those again to\n % look for more variables to rename.\n %\nexpr_make_vars_unique(Expr0, Expr, !SeenVars, !Varmap) :-\n expr(Type, Info) = Expr0,\n ( Type = e_tuple(Exprs0),\n map_foldl2(expr_make_vars_unique, Exprs0, Exprs, !SeenVars, !Varmap),\n Expr = expr(e_tuple(Exprs), Info)\n ; Type = e_lets(Lets0, In0),\n map_foldl3(let_make_vars_unique, Lets0, Lets, map.init, Renaming,\n !SeenVars, !Varmap),\n rename_expr(Renaming, In0, In1),\n expr_make_vars_unique(In1, In, !SeenVars, !Varmap),\n Expr = expr(e_lets(Lets, In), Info)\n ; Type = e_match(Var, Cases0),\n map_foldl2(case_make_vars_unique, Cases0, Cases, !SeenVars, !Varmap),\n Expr = expr(e_match(Var, Cases), Info)\n ;\n ( Type = e_call(_, _, _)\n ; Type = e_var(_)\n ; Type = e_constant(_)\n ; Type = e_construction(_, _)\n ; Type = e_closure(_, _)\n ),\n Expr = Expr0\n ).\n\n:- pred let_make_vars_unique(expr_let::in, expr_let::out,\n map(var, var)::in, map(var, var)::out, set(var)::in, set(var)::out,\n varmap::in, varmap::out) is det.\n\nlet_make_vars_unique(e_let(Vars0, Expr0), e_let(Vars, Expr), !Renaming,\n !SeenVars, !Varmap) :-\n % There are two steps.\n\n % First do the renaming computed after visiting earlier lets.\n ( if not is_empty(!.Renaming) then\n rename_expr(!.Renaming, Expr0, Expr1)\n else\n Expr1 = Expr0\n ),\n\n % Then update the renaming for variables seen here.\n VarsToRename = list_to_set(Vars0) `intersect` !.SeenVars,\n ( if not is_empty(VarsToRename) then\n make_renaming(VarsToRename, Renaming, !Varmap),\n !:Renaming = merge(!.Renaming, Renaming),\n map(rename_var(Renaming), Vars0, Vars)\n else\n Vars = Vars0\n ),\n !:SeenVars = !.SeenVars `union` list_to_set(Vars),\n expr_make_vars_unique(Expr1, Expr, !SeenVars, !Varmap).\n\n:- pred case_make_vars_unique(expr_case::in, expr_case::out,\n set(var)::in, set(var)::out, varmap::in, varmap::out) is det.\n\ncase_make_vars_unique(e_case(Pat0, Expr0), e_case(Pat, Expr), !SeenVars,\n !Varmap) :-\n ( Pat0 = p_variable(Var0),\n ( if member(Var0, !.SeenVars) then\n VarToRenameSet = make_singleton_set(Var0),\n some [!Renaming] (\n make_renaming(VarToRenameSet, Renaming, !Varmap),\n rename_var(Renaming, Var0, Var),\n rename_expr(Renaming, Expr0, Expr1)\n )\n else\n Var = Var0,\n Expr1 = Expr0\n ),\n insert(Var, !SeenVars),\n Pat = p_variable(Var)\n ; Pat0 = p_ctor(Ctors, Vars0),\n VarsToRename = !.SeenVars `intersect` list_to_set(Vars0),\n ( if not is_empty(VarsToRename) then\n make_renaming(VarsToRename, Renaming, !Varmap),\n map(rename_var(Renaming), Vars0, Vars),\n rename_expr(Renaming, Expr0, Expr1)\n else\n Vars = Vars0,\n Expr1 = Expr0\n ),\n !:SeenVars = !.SeenVars `union` list_to_set(Vars),\n Pat = p_ctor(Ctors, Vars)\n ;\n ( Pat0 = p_num(_)\n ; Pat0 = p_wildcard\n ),\n Pat = Pat0,\n Expr1 = Expr0\n ),\n expr_make_vars_unique(Expr1, Expr, !SeenVars, !Varmap).\n\n%-----------------------------------------------------------------------%\n\nexpr_has_branch(expr(Type, _)) :-\n require_complete_switch [Type]\n ( Type = e_tuple(Exprs),\n any_true(expr_has_branch, Exprs)\n ; Type = e_lets(Lets, Expr),\n (\n any_true((pred(e_let(_, E)::in) is semidet :-\n expr_has_branch(E)\n ), Lets)\n ;\n expr_has_branch(Expr)\n )\n ;\n ( Type = e_call(_, _, _)\n ; Type = e_var(_)\n ; Type = e_constant(_)\n ; Type = e_construction(_, _)\n ; Type = e_closure(_, _)\n ),\n false\n ;\n Type = e_match(_, _)\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.function.m", "content": "%-----------------------------------------------------------------------%\n% Plasma function representation\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module core.function.\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module context.\n:- import_module pz.\n:- import_module pz.code.\n\n%-----------------------------------------------------------------------%\n\n:- type function.\n\n % func_init_user(Name, Context, Sharing, ParamTypes, ReturnTypes,\n % Uses, Observes) = Function\n %\n % Create a user-provided function.\n %\n:- func func_init_user(q_name, context, sharing, list(type_), list(type_),\n set(resource_id), set(resource_id)) = function.\n\n % func_init_builtin_inline_pz(Name, Inputs, Outputs, Uses, Observes,\n % Defn) = Function\n %\n % Creates a builitn function defined by a list of PZ instructions. See\n % comment in builtins.m\n %\n:- func func_init_builtin_inline_pz(q_name, list(type_), list(type_),\n set(resource_id), set(resource_id), list(pz_instr)) = function.\n\n % func_init_builtin_rts(Name, Inputs, Outputs, Uses, Observes) =\n % Function\n %\n % Creates a builtin function that will be defined by the runtime system.\n %\n:- func func_init_builtin_rts(q_name, list(type_), list(type_),\n set(resource_id), set(resource_id)) = function.\n\n % func_init_builtin_core(Name, Inputs, Outputs, Uses, Observes) =\n % Function\n %\n % Creates a builtin function that has a \"Plasma core\" representation\n % compiled in each module and made available to optimisations.\n %\n:- func func_init_builtin_core(q_name, list(type_), list(type_),\n set(resource_id), set(resource_id)) = function.\n\n % func_init_anon(ModuleName, Sharing, Params, Results, Uses, Observes)\n %\n:- func func_init_anon(q_name, sharing, list(type_), list(type_),\n set(resource_id), set(resource_id)) = function.\n\n:- func func_get_name(function) = q_name.\n\n:- func func_get_context(function) = context.\n\n:- func func_get_imported(function) = imported.\n\n:- pred func_set_imported(function::in, function::out) is det.\n\n:- func func_get_sharing(function) = sharing.\n\n:- pred func_get_type_signature(function::in, list(type_)::out,\n list(type_)::out, arity::out) is det.\n\n % func_get_resource_signature(Func, Uses, Observes).\n %\n:- pred func_get_resource_signature(function::in,\n set(resource_id)::out, set(resource_id)::out) is det.\n\n:- type func_is_used\n ---> used_probably\n ; unused.\n\n:- func func_get_used(function) = func_is_used.\n\n:- pred func_set_used(func_is_used::in, function::in, function::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- pred func_set_captured_vars_types(list(type_)::in,\n function::in, function::out) is det.\n\n % Throws an exception if typechecking has not provided this.\n %\n:- func func_get_captured_vars_types(function) = list(type_).\n\n:- func func_maybe_captured_vars_types(function) = maybe(list(type_)).\n\n%-----------------------------------------------------------------------%\n\n:- pred func_is_builtin(function::in) is semidet.\n\n % The three main types of builtins. See the comment at the beginning of\n % builtins.m. This only makes sense for functions in the builtin\n % module.\n %\n:- type builtin_impl_type\n ---> bit_core % Builtins implemented by the compiler in core\n % representation.\n\n ; bit_inline_pz % Builtins implemented by the compiler by\n % replacing their use with PZ instructions (eg\n % math operators)\n\n ; bit_rts. % Bultins implemented by the RTS.\n\n % Get how this function's definition is provided if it is a builtin,\n % false otherwise.\n %\n:- pred func_builtin_type(function::in, builtin_impl_type::out) is semidet.\n\n:- pred func_set_builtin(builtin_impl_type::in, function::in, function::out)\n is det.\n\n:- pred func_builtin_inline_pz(function::in, list(pz_instr)::out)\n is semidet.\n\n:- pred func_set_foreign(function::in, function::out) is det.\n\n:- pred func_is_foreign(function::in) is semidet.\n\n:- type code_type\n ---> ct_plasma\n ; ct_foreign\n ; ct_builtin(\n builtin_impl_type\n ).\n\n:- func func_get_code_type(function) = code_type.\n\n%-----------------------------------------------------------------------%\n\n % func_set_body(Varmap, Params, Captured, Body, !func).\n %\n:- pred func_set_body(varmap::in, list(var)::in, list(var)::in, expr::in,\n function::in, function::out) is det.\n\n:- pred func_set_body(varmap::in, list(var)::in, list(var)::in, expr::in,\n map(var, type_)::in, function::in, function::out) is det.\n\n:- pred func_set_vartypes(map(var, type_)::in, function::in, function::out)\n is det.\n\n % func_get_body(Func, Varmap, ParamNames, Captured, Expr)\n %\n:- pred func_get_body(function::in, varmap::out, list(var)::out,\n list(var)::out, expr::out) is semidet.\n\n % func_get_body_det(Func, Varmap, ParamNames, Captured, Expr)\n %\n:- pred func_get_body_det(function::in, varmap::out, list(var)::out,\n list(var)::out, expr::out) is det.\n\n:- pred func_get_varmap(function::in, varmap::out) is semidet.\n\n:- pred func_get_vartypes(function::in, map(var, type_)::out) is semidet.\n\n:- func func_get_vartypes_det(function) = map(var, type_).\n\n:- pred func_raise_error(function::in, function::out) is det.\n\n:- pred func_has_error(function::in) is semidet.\n\n%-----------------------------------------------------------------------%\n\n:- func func_get_callees(function) = set(func_id).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module string.\n:- import_module require.\n\n%-----------------------------------------------------------------------%\n\n:- type function\n ---> function(\n f_name :: q_name,\n f_signature :: signature,\n f_context :: context,\n f_sharing :: sharing,\n f_maybe_func_defn :: maybe(function_defn),\n\n % Some builtins may be defined by a list of PZ\n % instructions.\n f_maybe_ipz_defn :: maybe(list(pz_instr)),\n f_code_type :: code_type,\n f_imported :: imported,\n f_used :: func_is_used,\n f_has_errors :: has_errors\n ).\n\n:- type signature\n ---> signature(\n % The parameter and return types are given in the order they\n % appear in function's definition.\n fs_param_types :: list(type_),\n fs_return_types :: list(type_),\n fs_captured_types :: maybe(list(type_)),\n % It seems redundant to store the list of return types and\n % the arity. However in the future return types may be\n % inferred, and therefore won't be available all the time.\n fs_arity :: arity,\n fs_uses :: set(resource_id),\n fs_observes :: set(resource_id)\n ).\n\n:- type function_defn\n ---> function_defn(\n fd_var_map :: varmap,\n fd_param_names :: list(var),\n fd_maybe_var_types :: maybe(map(var, type_)),\n fd_captured :: list(var),\n fd_body :: expr\n ).\n\n:- type has_errors\n ---> does_not_have_errors\n ; has_errors.\n\n%-----------------------------------------------------------------------%\n\nfunc_init_user(Name, Context, Sharing, Params, Return, Uses, Observes) =\n func_init(Name, Context, Sharing, Params, Return, Uses, Observes).\n\nfunc_init_builtin_inline_pz(Name, Params, Return, Uses, Observes,\n PzInstrs) =\n func_init_builtin(Name, Params, Return, [], Uses, Observes,\n bit_inline_pz, no, yes(PzInstrs)).\n\nfunc_init_builtin_rts(Name, Params, Return, Uses, Observes) =\n func_init_builtin(Name, Params, Return, [], Uses, Observes, bit_rts,\n no, no).\n\nfunc_init_builtin_core(Name, Params, Return, Uses, Observes) =\n func_init_builtin(Name, Params, Return, [], Uses, Observes, bit_core,\n no, no).\n\n:- func func_init_builtin(q_name, list(type_), list(type_), list(type_),\n set(resource_id), set(resource_id), builtin_impl_type,\n maybe(function_defn), maybe(list(pz_instr))) = function.\n\nfunc_init_builtin(Name, Params, Return, Captured, Uses, Observes,\n BuiltinImplType, MbDefn, MbIPzDefn) = Func :-\n Context = builtin_context,\n Sharing = s_private,\n Arity = arity(length(Return)),\n CodeType = ct_builtin(BuiltinImplType),\n Func = function(Name, signature(Params, Return, yes(Captured), Arity,\n Uses, Observes), Context, Sharing, MbDefn, MbIPzDefn, CodeType,\n i_imported, used_probably, does_not_have_errors).\n\nfunc_init_anon(ModuleName, Sharing, Params, Return, Uses, Observes) =\n func_init(q_name_append_str(ModuleName, \"Anon\"), nil_context,\n Sharing, Params, Return, Uses, Observes).\n\n:- func func_init(q_name, context, sharing, list(type_), list(type_),\n set(resource_id), set(resource_id)) = function.\n\nfunc_init(Name, Context, Sharing, Params, Return, Uses, Observes)\n = Func :-\n Arity = arity(length(Return)),\n Func = function(Name, signature(Params, Return, no, Arity, Uses, Observes),\n Context, Sharing, no, no, ct_plasma, i_local, used_probably,\n does_not_have_errors).\n\nfunc_get_name(Func) = Func ^ f_name.\n\nfunc_get_context(Func) = Func ^ f_context.\n\nfunc_get_imported(Func) = Func ^ f_imported.\n\nfunc_set_imported(!Func) :-\n !Func ^ f_signature ^ fs_captured_types := yes([]),\n !Func ^ f_imported := i_imported.\n\nfunc_get_sharing(Func) = Func ^ f_sharing.\n\nfunc_get_type_signature(Func, Inputs, Outputs, Arity) :-\n Inputs = Func ^ f_signature ^ fs_param_types,\n Outputs = Func ^ f_signature ^ fs_return_types,\n Arity = Func ^ f_signature ^ fs_arity.\n\nfunc_get_resource_signature(Func, Uses, Observes) :-\n Uses = Func ^ f_signature ^ fs_uses,\n Observes = Func ^ f_signature ^ fs_observes.\n\nfunc_get_used(Func) = Func ^ f_used.\n\nfunc_set_used(Used, !Func) :-\n !Func ^ f_used := Used.\n\n%-----------------------------------------------------------------------%\n\nfunc_set_captured_vars_types(Types, !Func) :-\n !Func ^ f_signature ^ fs_captured_types := yes(Types).\n\nfunc_get_captured_vars_types(Func) = Types :-\n MaybeTypes = func_maybe_captured_vars_types(Func),\n ( MaybeTypes = yes(Types)\n ; MaybeTypes = no,\n unexpected($file, $pred,\n format(\"Captured vars' types unknown for %s\",\n [s(q_name_to_string(Func ^ f_name))]))\n ).\n\nfunc_maybe_captured_vars_types(Func) =\n Func ^ f_signature ^ fs_captured_types.\n\n%-----------------------------------------------------------------------%\n\nfunc_is_builtin(Func) :-\n func_builtin_type(Func, _).\n\nfunc_builtin_type(Func, BuiltinType) :-\n ct_builtin(BuiltinType) = Func ^ f_code_type.\n\nfunc_set_builtin(BuiltinType, !Func) :-\n ( if\n not func_is_builtin(!.Func),\n not func_is_foreign(!.Func),\n no = !.Func ^ f_maybe_func_defn\n then\n !Func ^ f_code_type := ct_builtin(BuiltinType),\n func_set_captured_vars_types([], !Func)\n else\n unexpected($file, $pred,\n \"Function is already builtin or already has a body\")\n ).\n\nfunc_builtin_inline_pz(Func, PZInstrs) :-\n yes(PZInstrs) = Func ^ f_maybe_ipz_defn.\n\nfunc_set_foreign(!Func) :-\n ( if\n not func_is_builtin(!.Func),\n not func_is_foreign(!.Func),\n no = !.Func ^ f_maybe_func_defn\n then\n !Func ^ f_code_type := ct_foreign,\n func_set_captured_vars_types([], !Func)\n else\n unexpected($file, $pred,\n \"Function is already builtin or already has a body\")\n ).\n\nfunc_is_foreign(Func) :-\n Func ^ f_code_type = ct_foreign.\n\nfunc_get_code_type(Func) = Func ^ f_code_type.\n\n%-----------------------------------------------------------------------%\n\nfunc_set_body(Varmap, ParamNames, Captured, Expr, !Function) :-\n ( if func_get_vartypes(!.Function, Vartypes) then\n MaybeVartypes = yes(Vartypes)\n else\n MaybeVartypes = no\n ),\n Defn = function_defn(Varmap, ParamNames, MaybeVartypes, Captured, Expr),\n !Function ^ f_maybe_func_defn := yes(Defn).\n\nfunc_set_body(Varmap, ParamNames, Captured, Expr, VarTypes, !Function) :-\n Defn = function_defn(Varmap, ParamNames, yes(VarTypes), Captured, Expr),\n !Function ^ f_maybe_func_defn := yes(Defn).\n\nfunc_set_vartypes(VarTypes, !Function) :-\n MaybeDefn0 = !.Function ^ f_maybe_func_defn,\n ( MaybeDefn0 = no,\n unexpected($file, $pred, \"No function body\")\n ; MaybeDefn0 = yes(function_defn(Varmap, ParamNames, _, Captured, Expr)),\n Defn = function_defn(Varmap, ParamNames, yes(VarTypes),\n Captured, Expr),\n !Function ^ f_maybe_func_defn := yes(Defn)\n ).\n\nfunc_get_body(Func, Varmap, ParamNames, Captured, Expr) :-\n yes(Defn) = Func ^ f_maybe_func_defn,\n function_defn(Varmap, ParamNames, _VarTypes, Captured, Expr) = Defn.\n\nfunc_get_body_det(Func, Varmap, ParamNames, Captured, Expr) :-\n ( if func_get_body(Func, VarmapP, ParamNamesP, CapturedP, ExprP) then\n Varmap = VarmapP,\n ParamNames = ParamNamesP,\n Captured = CapturedP,\n Expr = ExprP\n else\n unexpected($file, $pred, \"coudln't get predicate baody\")\n ).\n\nfunc_get_varmap(Func, Varmap) :-\n func_get_body(Func, Varmap, _, _, _).\n\nfunc_get_vartypes(Func, VarTypes) :-\n yes(Defn) = Func ^ f_maybe_func_defn,\n yes(VarTypes) = Defn ^ fd_maybe_var_types.\n\nfunc_get_vartypes_det(Func) = VarTypes :-\n ( if func_get_vartypes(Func, VarTypesPrime) then\n VarTypes = VarTypesPrime\n else\n unexpected($file, $pred, \"No VarTypes\")\n ).\n\nfunc_raise_error(!Func) :-\n !Func ^ f_has_errors := has_errors.\n\nfunc_has_error(Func) :-\n Func ^ f_has_errors = has_errors.\n\n%-----------------------------------------------------------------------%\n\nfunc_get_callees(Func) = Callees :-\n MaybeDefn = Func ^ f_maybe_func_defn,\n ( MaybeDefn = yes(function_defn(_, _, _, _, Body)),\n Callees = expr_get_callees(Body)\n ; MaybeDefn = no,\n Callees = set.init\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT see ../LICENSE.code\n%\n% Plasma core representation\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- include_module core.code.\n:- include_module core.function.\n:- include_module core.pretty.\n:- include_module core.resource.\n:- include_module core.types.\n\n:- include_module core.arity_chk.\n:- include_module core.branch_chk.\n:- include_module core.res_chk.\n:- include_module core.simplify.\n:- include_module core.type_chk.\n\n:- include_module core.util.\n\n%-----------------------------------------------------------------------%\n\n:- import_module assoc_list.\n:- import_module list.\n:- import_module set.\n\n:- import_module common_types.\n:- import_module core.function.\n:- import_module core.resource.\n:- import_module core.types.\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\n:- type core.\n\n:- func init(q_name) = core.\n\n:- func module_name(core) = q_name.\n\n:- pred core_allocate_function(func_id::out, core::in, core::out) is det.\n\n:- func core_all_functions(core) = assoc_list(func_id, function).\n\n:- func core_all_functions_set(core) = set(func_id).\n\n % All functions with bodies.\n %\n:- func core_all_defined_functions(core) = assoc_list(func_id, function).\n\n:- func core_all_defined_functions_set(core) = set(func_id).\n\n:- func core_all_exported_functions(core) = assoc_list(func_id, function).\n\n:- pred core_set_function(func_id::in, function::in, core::in, core::out)\n is det.\n\n:- pred core_get_function_det(core::in, func_id::in, function::out) is det.\n\n:- type core_entrypoint\n % The entrypoint is func() -> Int\n ---> entry_plain(func_id)\n\n % The entrypoint is func(argv : List(String)) -> Int\n ; entry_argv(func_id).\n\n:- func core_entry_candidates(core) = set(core_entrypoint).\n\n:- pred core_add_entry_function(core_entrypoint::in, core::in, core::out)\n is det.\n\n:- func core_lookup_function_name(core, func_id) = q_name.\n\n%-----------------------------------------------------------------------%\n\n % Return all the defined functions, topologically sorted into their\n % SCCs.\n %\n:- func core_all_defined_functions_sccs(core) = list(set(func_id)).\n\n%-----------------------------------------------------------------------%\n\n:- pred core_allocate_type_id(type_id::out, core::in, core::out) is det.\n\n:- func core_all_types(core) = assoc_list(type_id, user_type).\n\n:- func core_all_exported_types(core) = assoc_list(type_id, user_type).\n\n:- func core_get_type(core, type_id) = user_type.\n\n:- pred core_set_type(type_id::in, user_type::in, core::in, core::out)\n is det.\n\n:- func core_lookup_type_name(core, type_id) = q_name.\n\n:- pred core_allocate_ctor_id(ctor_id::out, core::in, core::out) is det.\n\n:- func core_lookup_constructor_name(core, ctor_id) = q_name.\n\n:- pred core_get_constructor_type(core::in, ctor_id::in, type_id::out) is det.\n\n:- pred core_get_constructor_det(core::in, ctor_id::in,\n constructor::out) is det.\n\n:- pred core_set_constructor(ctor_id::in, q_name::in, type_id::in,\n constructor::in, core::in, core::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- pred core_allocate_resource_id(resource_id::out, core::in, core::out)\n is det.\n\n:- pred core_set_resource(resource_id::in, resource::in,\n core::in, core::out) is det.\n\n:- func core_get_resource(core, resource_id) = resource.\n\n:- func core_all_exported_resources(core) = assoc_list(resource_id, resource).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module digraph.\n:- import_module int.\n:- import_module map.\n:- import_module maybe.\n:- import_module pair.\n:- import_module varmap.\n\n:- import_module core.code.\n:- import_module util.\n:- import_module util.my_exception.\n\n%-----------------------------------------------------------------------%\n\n:- type core\n ---> core(\n c_module_name :: q_name,\n\n c_funcs :: map(func_id, function),\n c_next_func_id :: func_id,\n c_entry_candidates :: set(core_entrypoint),\n\n c_next_type_id :: type_id,\n c_types :: map(type_id, user_type),\n\n c_next_ctor_id :: ctor_id,\n c_constructors :: map(ctor_id, ctor_info),\n\n c_next_res_id :: resource_id,\n c_resources :: map(resource_id, resource)\n ).\n\n:- type ctor_info\n ---> ctor_info(\n ci_name :: q_name,\n ci_arity :: int,\n ci_type_id :: type_id,\n ci_constructor :: constructor\n ).\n\n%-----------------------------------------------------------------------%\n\ninit(ModuleName) =\n core(ModuleName,\n % Functions\n init, func_id(0), init,\n % Types\n type_id(0), init,\n % Constructors\n ctor_id(0), init,\n % Resources\n resource_id(0), init\n ).\n\nmodule_name(Core) = Core ^ c_module_name.\n\n%-----------------------------------------------------------------------%\n\ncore_allocate_function(FuncId, !Core) :-\n FuncId = !.Core ^ c_next_func_id,\n FuncId = func_id(N),\n !Core ^ c_next_func_id := func_id(N+1).\n\ncore_all_functions(Core) = to_assoc_list(Core ^ c_funcs).\n\ncore_all_functions_set(Core) = keys_as_set(Core ^ c_funcs).\n\ncore_all_defined_functions(Core) =\n filter(is_defined, core_all_functions(Core)).\n\ncore_all_defined_functions_set(Core) =\n list_to_set(map(fst, core_all_defined_functions(Core))).\n\n:- pred is_defined(pair(_, function)::in) is semidet.\n\nis_defined(_ - Func) :-\n func_get_body(Func, _, _, _, _).\n\ncore_all_exported_functions(Core) =\n filter(is_exported, core_all_functions(Core)).\n\n:- pred is_exported(pair(_, function)::in) is semidet.\n\nis_exported(_ - Func) :-\n func_get_sharing(Func) = s_public.\n\ncore_set_function(FuncId, Func, !Core) :-\n map.set(FuncId, Func, !.Core ^ c_funcs, Funcs),\n !Core ^ c_funcs := Funcs.\n\ncore_get_function_det(Core, FuncId, Func) :-\n map.lookup(Core ^ c_funcs, FuncId, Func).\n\ncore_entry_candidates(Core) = Core ^ c_entry_candidates.\n\ncore_add_entry_function(Entrypoint, !Core) :-\n !Core ^ c_entry_candidates :=\n insert(!.Core ^ c_entry_candidates, Entrypoint).\n\ncore_lookup_function_name(Core, FuncId) = func_get_name(Func) :-\n core_get_function_det(Core, FuncId, Func).\n\n%-----------------------------------------------------------------------%\n\ncore_all_defined_functions_sccs(Core) = SCCs :-\n AllFuncs = map(fst, core_all_defined_functions(Core)),\n AllFuncsSet = list_to_set(AllFuncs),\n some [!Graph] (\n !:Graph = digraph.init,\n map_foldl(add_vertex, AllFuncs, _, !Graph),\n foldl(core_build_graph(Core, AllFuncsSet), AllFuncs, !Graph),\n SCCs = atsort(!.Graph)\n ).\n\n:- pred core_build_graph(core::in, set(func_id)::in, func_id::in,\n digraph(func_id)::in, digraph(func_id)::out) is det.\n\ncore_build_graph(Core, AllFuncs, FuncId, !Graph) :-\n core_get_function_det(Core, FuncId, Func),\n Callees = func_get_callees(Func),\n FuncIdKey = lookup_key(!.Graph, FuncId),\n foldl(core_add_edge(AllFuncs, FuncIdKey), Callees, !Graph).\n\n:- pred core_add_edge(set(func_id)::in, digraph_key(func_id)::in, func_id::in,\n digraph(func_id)::in, digraph(func_id)::out) is det.\n\ncore_add_edge(AllFuncs, CallerKey, Callee, !Graph) :-\n ( if set.member(Callee, AllFuncs) then\n CalleeKey = lookup_key(!.Graph, Callee),\n add_edge(CallerKey, CalleeKey, !Graph)\n else\n true\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\ncore_allocate_type_id(TypeId, !Core) :-\n TypeId = !.Core ^ c_next_type_id,\n TypeId = type_id(N),\n !Core ^ c_next_type_id := type_id(N+1).\n\ncore_all_types(Core) = to_assoc_list(Core ^ c_types).\n\ncore_all_exported_types(Core) =\n filter(type_is_exported, core_all_types(Core)).\n\n:- pred type_is_exported(pair(_, user_type)::in) is semidet.\n\ntype_is_exported(_ - Type) :-\n Sharing = utype_get_sharing(Type),\n sharing_is_exported(Sharing).\n\ncore_get_type(Core, TypeId) = Type :-\n lookup(Core ^ c_types, TypeId, Type).\n\ncore_set_type(TypeId, Type, !Core) :-\n set(TypeId, Type, !.Core ^ c_types, Map),\n !Core ^ c_types := Map.\n\ncore_lookup_type_name(Core, TypeId) =\n utype_get_name(core_get_type(Core, TypeId)).\n\n%-----------------------------------------------------------------------%\n\ncore_allocate_ctor_id(CtorId, !Core) :-\n CtorId = !.Core ^ c_next_ctor_id,\n CtorId = ctor_id(N),\n !Core ^ c_next_ctor_id := ctor_id(N+1).\n\ncore_lookup_constructor_name(Core, CtorId) = Info ^ ci_name :-\n lookup(Core ^ c_constructors, CtorId, Info).\n\ncore_get_constructor_type(Core, CtorId, Info ^ ci_type_id) :-\n lookup(Core ^ c_constructors, CtorId, Info).\n\ncore_get_constructor_det(Core, CtorId, Info ^ ci_constructor) :-\n lookup(Core ^ c_constructors, CtorId, Info).\n\ncore_set_constructor(CtorId, Name, TypeId, Cons, !Core) :-\n Info = ctor_info(Name, length(Cons ^ c_fields), TypeId, Cons),\n det_insert(CtorId, Info, !.Core ^ c_constructors, ConsMap),\n !Core ^ c_constructors := ConsMap.\n\n%-----------------------------------------------------------------------\n%-----------------------------------------------------------------------\n\ncore_allocate_resource_id(ResId, !Core) :-\n ResId = !.Core ^ c_next_res_id,\n resource_id(N) = ResId,\n !Core ^ c_next_res_id := resource_id(N+1).\n\ncore_set_resource(ResId, Res, !Core) :-\n map.set(ResId, Res, !.Core ^ c_resources, NewMap),\n !Core ^ c_resources := NewMap.\n\ncore_get_resource(Core, ResId) = map.lookup(Core ^ c_resources, ResId).\n\ncore_all_exported_resources(Core) =\n filter(resource_is_exported, to_assoc_list(Core ^ c_resources)).\n\n:- pred resource_is_exported(pair(resource_id, resource)::in) is semidet.\n\nresource_is_exported(_ - r_other(_, _, Sharing, _, _)) :-\n sharing_is_exported(Sharing).\n\n:- pred sharing_is_exported(sharing_opaque::in) is semidet.\n\nsharing_is_exported(so_public).\nsharing_is_exported(so_public_opaque).\n\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.pretty.m", "content": "%-----------------------------------------------------------------------%\n% Plasma code pretty printer\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module core.pretty.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module cord.\n:- import_module string.\n\n:- import_module util.\n:- import_module util.pretty.\n\n:- func core_pretty(core) = cord(string).\n\n % Pretty print a function declaration (used by write_interface).\n %\n:- func func_decl_pretty(core, function) = list(pretty).\n\n % This is used by the code-generator's comments, so it returns a\n % string.\n %\n:- func func_call_pretty(core, function, varmap, list(var)) = string.\n\n:- func type_pretty(core, type_) = pretty.\n\n % Print the type declaration. If the type is abstract exported none of\n % the constructors will be printed.\n %\n % This is only used by write_interface, if we need to use it elsewhere\n % we probably should parameterise it and other pretty-printer functions\n % here.\n %\n:- func type_interface_pretty(core, user_type) = pretty.\n\n % Print the argument parts of a function type. You can either put\n % \"func\" in front of this or the name of the variable at a call site.\n %\n % It is also used only by the code generator's commenting.\n %\n:- func type_pretty_func(core, string, list(type_), list(type_),\n set(resource_id), set(resource_id)) = string.\n\n % func_pretty_template(Name, Inputs, Outputs, Uses, Observes) = Pretty.\n %\n % This function can print something in the style of a function\n % declaration. Whether the arguments are names, types, or both.\n %\n:- func func_pretty_template(pretty, list(pretty), list(pretty), list(pretty),\n list(pretty)) = pretty.\n\n % Pretty print a resource use (just it's name).\n %\n:- func resource_pretty(core, resource_id) = pretty.\n\n % Pretty print a resource definition.\n %\n:- func resource_interface_pretty(core, resource) = pretty.\n\n:- func constructor_name_pretty(core, set(ctor_id)) = pretty.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module pair.\n:- import_module require.\n\n:- import_module builtins.\n:- import_module context.\n:- import_module core.types.\n:- import_module util.mercury.\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\ncore_pretty(Core) = pretty(default_options, 0, Pretty) :-\n ModuleDecl = [p_str(\"module\"), p_spc, q_name_pretty(module_name(Core))],\n Funcs = map(func_pretty(Core), core_all_functions(Core)),\n Pretty = [p_list(ModuleDecl ++ condense(Funcs)), p_nl_hard].\n\n%-----------------------------------------------------------------------%\n\ntype_interface_pretty(Core, Type) = p_expr(Pretty) :-\n Sharing = utype_get_sharing(Type),\n ( Sharing = so_private,\n unexpected($file, $pred, \"st_private\")\n ; Sharing = so_public,\n MaybeParams = utype_get_params(Type),\n ( MaybeParams = yes(Params)\n ; MaybeParams = no,\n unexpected($file, $pred, \"No parameters for public type\")\n ),\n PrettyHead = [p_str(\"type \"),\n pretty_optional_args(\n q_name_pretty(utype_get_name(Type)),\n map(type_arg_pretty, Params))],\n MaybeCtors = utype_get_ctors(Type),\n ( MaybeCtors = yes(Ctors),\n PrettyBody = [p_str(\" \"), p_tabstop, p_str(\"= \")] ++\n pretty_seperated(\n [p_nl_hard, p_str(\"| \")],\n map(ctor_pretty(Core), Ctors))\n ; MaybeCtors = no,\n unexpected($file, $pred, \"Public type without constructors\")\n ),\n Pretty = PrettyHead ++ PrettyBody\n ; Sharing = so_public_opaque,\n Pretty = [p_str(\"type \"),\n q_name_pretty(utype_get_name(Type)),\n p_str(\"/\"),\n p_str(string(utype_get_arity(Type) ^ a_num))]\n ).\n\n:- func type_arg_pretty(string) = pretty.\n\ntype_arg_pretty(Name) = p_expr([p_str(\"'\"), p_str(Name)]).\n\n:- func ctor_pretty(core, ctor_id) = pretty.\n\nctor_pretty(Core, CtorId) = Pretty :-\n core_get_constructor_det(Core, CtorId, Ctor),\n Pretty = pretty_optional_args(q_name_pretty(Ctor ^ c_name),\n map(field_pretty(Core), Ctor ^ c_fields)).\n\n:- func field_pretty(core, type_field) = pretty.\n\nfield_pretty(Core, type_field(Name, Type)) =\n p_expr([q_name_pretty(Name), p_str(\" : \"), p_nl_soft,\n type_pretty(Core, Type)]).\n\n%-----------------------------------------------------------------------%\n\n:- func func_pretty(core, pair(func_id, function)) = list(pretty).\n\nfunc_pretty(Core, FuncId - Func) = FuncPretty :-\n FuncId = func_id(FuncIdInt),\n FuncIdPretty = [p_str(format(\"// func: %d\", [i(FuncIdInt)])), p_nl_hard],\n FuncDecl = func_decl_pretty(Core, Func),\n ( if func_get_body(Func, _, _, _, _) then\n FuncPretty0 = [p_group_curly(FuncDecl, singleton(\"{\"),\n func_body_pretty(Core, Func), singleton(\"}\"))]\n else\n FuncPretty0 = [p_expr(FuncDecl ++ [p_str(\";\")])]\n ),\n FuncPretty = [p_nl_double] ++ FuncIdPretty ++ FuncPretty0.\n\nfunc_decl_pretty(Core, Func) =\n [p_str(\"func \"),\n func_pretty_template(Name, Args, Returns, Uses, Observes)] :-\n Name = q_name_pretty(func_get_name(Func)),\n func_get_type_signature(Func, ParamTypes, ReturnTypes, _),\n ( if func_get_body(Func, Varmap, ParamNames, _Captured, _Expr) then\n Args = params_pretty(Core, Varmap, ParamNames, ParamTypes)\n else\n Args = map(type_pretty(Core), ParamTypes)\n ),\n Returns = map(type_pretty(Core), ReturnTypes),\n\n func_get_resource_signature(Func, UsesSet, ObservesSet),\n Uses = map(resource_pretty(Core), set.to_sorted_list(UsesSet)),\n Observes = map(resource_pretty(Core), set.to_sorted_list(ObservesSet)).\n\nfunc_call_pretty(Core, Func, Varmap, Args) =\n pretty_str([func_call_pretty_2(Core, Func, Varmap, Args)]).\n\n:- func func_call_pretty_2(core, function, varmap, list(var)) = pretty.\n\nfunc_call_pretty_2(Core, Func, Varmap, Args) =\n func_pretty_template(Name, ArgsPretty, [], [], []) :-\n Name = q_name_pretty(func_get_name(Func)),\n func_get_type_signature(Func, ParamTypes, _, _),\n ArgsPretty = params_pretty(Core, Varmap, Args, ParamTypes).\n\n:- func params_pretty(core, varmap, list(var), list(type_)) =\n list(pretty).\n\nparams_pretty(Core, Varmap, Names, Types) =\n map_corresponding(param_pretty(Core, Varmap), Names, Types).\n\n:- func param_pretty(core, varmap, var, type_) = pretty.\n\nparam_pretty(Core, Varmap, Var, Type) =\n p_expr([var_pretty(Varmap, Var), p_str(\" : \"),\n p_nl_soft, type_pretty(Core, Type)]).\n\n%-----------------------------------------------------------------------%\n\n:- func func_body_pretty(core, function) = list(pretty).\n\nfunc_body_pretty(Core, Func) = Pretty :-\n ( if func_get_body(Func, VarmapPrime, _, CapturedPrime, ExprPrime) then\n Varmap = VarmapPrime,\n Captured = CapturedPrime,\n Expr = ExprPrime\n else\n unexpected($file, $pred, \"Abstract function\")\n ),\n\n expr_pretty(Core, Varmap, Expr, ExprPretty, 0, _, map.init, _InfoMap),\n\n ( Captured = [],\n CapturedPretty = []\n ; Captured = [_ | _],\n CapturedPretty = [p_nl_double,\n p_comment(singleton(\"// \"), [p_str(\"Captured: \"), p_nl_soft,\n vars_pretty(Varmap, Captured)]\n )\n ]\n ),\n\n ( if func_get_vartypes(Func, VarTypes) then\n VarTypesPretty = [p_nl_double,\n p_comment(singleton(\"// \"),\n [p_expr([p_str(\"Types of variables: \"), p_nl_soft,\n p_list(pretty_seperated([p_nl_hard],\n map(var_type_map_pretty(Core, Varmap),\n to_assoc_list(VarTypes))))])])]\n else\n VarTypesPretty = []\n ),\n\n % _InfoMap could be printed, but we should also print expression numbers\n % if that's the case.\n\n Context = code_info_context(Expr ^ e_info),\n ( if not is_nil_context(Context) then\n ContextPretty = [p_str(\"// \"), p_str(context_string(Context)),\n p_nl_hard]\n else\n ContextPretty = []\n ),\n Pretty = ContextPretty ++ [ExprPretty] ++\n CapturedPretty ++ VarTypesPretty.\n\n%-----------------------------------------------------------------------%\n\n:- func var_type_map_pretty(core, varmap, pair(var, type_)) = pretty.\n\nvar_type_map_pretty(Core, Varmap, Var - Type) =\n p_expr([VarPretty, p_str(\": \"), p_nl_soft, TypePretty]) :-\n VarPretty = var_pretty(Varmap, Var),\n TypePretty = type_pretty(Core, Type).\n\n%-----------------------------------------------------------------------%\n\n% Expression numbers are currently unused, and no meta information is\n% currently printed about expressions. As we need it we should consider how\n% best to do this. Or we should print information directly within the\n% pretty-printed expression.\n\n% Note that expression nubers start at 0 and are allocated to parents before\n% children. This allows us to avoid printing the number of the first child\n% of any expression, which makes pretty printed output less cluttered, as\n% these numbers would otherwise appear consecutively in many expressions.\n% This must be the same throughout the compiler so that anything\n% using expression numbers makes sense when looking at pretty printed\n% reports.\n\n:- pred expr_pretty(core::in, varmap::in, expr::in, pretty::out,\n int::in, int::out, map(int, code_info)::in, map(int, code_info)::out)\n is det.\n\nexpr_pretty(Core, Varmap, Expr, Pretty, !ExprNum, !InfoMap) :-\n Expr = expr(ExprType, CodeInfo),\n\n MyExprNum = !.ExprNum,\n !:ExprNum = !.ExprNum + 1,\n\n det_insert(MyExprNum, CodeInfo, !InfoMap),\n\n ( ExprType = e_tuple(Exprs),\n map_foldl2(expr_pretty(Core, Varmap), Exprs, ExprsPretty,\n !ExprNum, !InfoMap),\n Pretty = pretty_callish(p_empty, ExprsPretty)\n ; ExprType = e_lets(Lets, In),\n map_foldl2(let_pretty(Core, Varmap), Lets, LetsPretty0,\n !ExprNum, !InfoMap),\n LetsPretty = list_join([p_nl_hard],\n map(func(L) = p_expr(L), LetsPretty0)),\n expr_pretty(Core, Varmap, In, InPretty, !ExprNum, !InfoMap),\n Pretty = p_expr([p_str(\"let \"), p_tabstop] ++\n LetsPretty ++ [p_nl_hard] ++\n [InPretty])\n ; ExprType = e_call(Callee, Args, _),\n ( Callee = c_plain(FuncId),\n CalleePretty = q_name_pretty(\n core_lookup_function_name(Core, FuncId))\n ; Callee = c_ho(CalleeVar),\n CalleePretty = var_pretty(Varmap, CalleeVar)\n ),\n ArgsPretty = map(func(V) = var_pretty(Varmap, V), Args),\n Pretty = pretty_callish(CalleePretty, ArgsPretty)\n ; ExprType = e_var(Var),\n Pretty = var_pretty(Varmap, Var)\n ; ExprType = e_constant(Const),\n Pretty = const_pretty(\n func(F) = q_name_pretty(core_lookup_function_name(Core, F)),\n constructor_name_pretty(Core),\n Const)\n ; ExprType = e_construction(CtorIds, Args),\n PrettyName = constructor_name_pretty(Core, CtorIds),\n PrettyArgs = map(func(V) = var_pretty(Varmap, V), Args),\n Pretty = pretty_optional_args(PrettyName, PrettyArgs)\n ; ExprType = e_closure(FuncId, Args),\n PrettyFunc = q_name_pretty(core_lookup_function_name(Core, FuncId)),\n PrettyArgs = map(func(V) = var_pretty(Varmap, V), Args),\n Pretty = pretty_callish(p_str(\"closure\"), [PrettyFunc | PrettyArgs])\n ; ExprType = e_match(Var, Cases),\n VarPretty =var_pretty(Varmap, Var),\n map_foldl2(case_pretty(Core, Varmap), Cases, CasesPretty,\n !ExprNum, !InfoMap),\n Pretty = p_group_curly(\n [p_str(\"match (\"), VarPretty, p_str(\")\")],\n singleton(\"{\"),\n list_join([p_nl_hard], CasesPretty),\n singleton(\"}\"))\n ).\n\n:- pred let_pretty(core::in, varmap::in, expr_let::in, list(pretty)::out,\n int::in, int::out, map(int, code_info)::in, map(int, code_info)::out)\n is det.\n\nlet_pretty(Core, Varmap, e_let(Vars, Let), Pretty,\n !ExprNum, !InfoMap) :-\n expr_pretty(Core, Varmap, Let, LetPretty, !ExprNum, !InfoMap),\n ( Vars = [],\n Pretty = [p_str(\"=\"), p_spc] ++ [LetPretty]\n ; Vars = [_ | _],\n VarsPretty = list_join([p_str(\", \"), p_nl_soft],\n map(func(V) = var_pretty(Varmap, V), Vars)),\n Pretty = [p_list(VarsPretty)] ++\n [p_spc, p_nl_soft, p_str(\"= \")] ++\n [LetPretty]\n ).\n\n:- pred case_pretty(core::in, varmap::in,\n expr_case::in, pretty::out, int::in, int::out,\n map(int, code_info)::in, map(int, code_info)::out) is det.\n\ncase_pretty(Core, Varmap, e_case(Pattern, Expr), Pretty, !ExprNum,\n !InfoMap) :-\n PatternPretty = pattern_pretty(Core, Varmap, Pattern),\n expr_pretty(Core, Varmap, Expr, ExprPretty, !ExprNum, !InfoMap),\n Pretty = p_expr([p_str(\"case \"), PatternPretty, p_str(\" -> \"),\n p_nl_soft, ExprPretty]).\n\n:- func pattern_pretty(core, varmap, expr_pattern) = pretty.\n\npattern_pretty(_, _, p_num(Num)) = p_str(string(Num)).\npattern_pretty(_, Varmap, p_variable(Var)) =\n var_pretty(Varmap, Var).\npattern_pretty(_, _, p_wildcard) = p_str(\"_\").\npattern_pretty(Core, Varmap, p_ctor(CtorIds, Args)) =\n pretty_optional_args(NamePretty, ArgsPretty) :-\n NamePretty = constructor_name_pretty(Core, CtorIds),\n ArgsPretty = map(func(V) = var_pretty(Varmap, V), Args).\n\n%-----------------------------------------------------------------------%\n\ntype_pretty(_, builtin_type(Builtin)) =\n q_name_pretty(q_name_append(builtin_module_name, Name)) :-\n builtin_type_name(Builtin, Name).\ntype_pretty(_, type_variable(Var)) = p_expr([p_str(\"'\"), p_str(Var)]).\ntype_pretty(Core, type_ref(TypeId, Args)) =\n pretty_optional_args(\n q_name_pretty(core_lookup_type_name(Core, TypeId)),\n map(type_pretty(Core), Args)).\ntype_pretty(Core, func_type(Args, Returns, Uses, Observes)) =\n type_pretty_func_2(Core, p_str(\"func\"), Args, Returns, Uses, Observes).\n\ntype_pretty_func(Core, Name, Args, Returns, Uses, Observes) =\n pretty_str([Pretty]) :-\n Pretty = type_pretty_func_2(Core, p_str(Name), Args, Returns,\n Uses, Observes).\n\n:- func type_pretty_func_2(core, pretty, list(type_), list(type_),\n set(resource_id), set(resource_id)) = pretty.\n\ntype_pretty_func_2(Core, Name, Args, Returns, Uses, Observes) =\n func_pretty_template(Name, map(type_pretty(Core), Args),\n map(type_pretty(Core), Returns),\n map(resource_pretty(Core), set.to_sorted_list(Uses)),\n map(resource_pretty(Core), set.to_sorted_list(Observes))).\n\nfunc_pretty_template(Name, Args, Returns, Uses, Observes) = Pretty :-\n ReturnsPretty = maybe_pretty_args_maybe_prefix(\n [p_spc, p_nl_soft, p_str(\"-> \")], Returns),\n UsesPretty = maybe_pretty_args_maybe_prefix(\n [p_spc, p_nl_soft, p_str(\"uses \")], Uses),\n ObservesPretty = maybe_pretty_args_maybe_prefix(\n [p_spc, p_nl_soft, p_str(\"observes \")], Observes),\n Pretty = p_expr([pretty_callish(Name, Args),\n UsesPretty, ObservesPretty, ReturnsPretty]).\n\n%-----------------------------------------------------------------------%\n\nresource_pretty(Core, ResId) =\n p_str(resource_to_string(core_get_resource(Core, ResId))).\n\nresource_interface_pretty(_, r_io) = unexpected($file, $pred, \"IO\").\nresource_interface_pretty(Core, r_other(Name, From, Sharing, _, _)) = Pretty :-\n ( Sharing = so_public,\n Pretty = p_expr([p_str(\"resource\"), p_spc, q_name_pretty(Name),\n p_spc, p_str(\"from\"), p_spc, resource_pretty(Core, From)])\n ; Sharing = so_public_opaque,\n Pretty = p_expr([p_str(\"resource\"), p_spc, q_name_pretty(Name)])\n ; Sharing = so_private,\n Pretty = p_empty\n ).\n\nresource_interface_pretty(_, r_abstract(Name)) =\n p_expr([p_str(\"resource\"), p_spc, q_name_pretty(Name)]).\n\n%-----------------------------------------------------------------------%\n\nconstructor_name_pretty(Core, CtorIds) = PrettyName :-\n ( if is_singleton(CtorIds, CtorId) then\n PrettyName = q_name_pretty(core_lookup_constructor_name(Core, CtorId))\n else if remove_least(CtorId, CtorIds, _) then\n % This is the first of many possible constructors, print only\n % the last part of the name.\n % TODO: We'll need to fix this if we allow renaming of symbols.\n QName = core_lookup_constructor_name(Core, CtorId),\n q_name_parts(QName, _, LastPart),\n PrettyName = nq_name_pretty(LastPart)\n else\n % Should never happen, but we can continue.\n PrettyName = p_str(\"???\")\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.res_chk.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core.res_chk.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT see ../LICENSE.code\n%\n% Plasma resource checking - post typechecking\n%\n% We do some resource checking before type checking, but need to repeat it\n% here for higher-order code. Resource checking needs to interact with the\n% typechecker to pass resource usage attributes on higher order functions\n% around through a function definition. The type checker and this module\n% have to coordinate carefully. Here's how it works.\n%\n% Resource are provided by some pieces of code (callers) and required by\n% others (callees). These are:\n%\n% Required by:\n% + Callees at call sites of their environment,\n% + Function constructors of the new value,\n% + Returns from calls returning functions (out arguments),\n% + Parameters of function definitions\n%\n% Provided by:\n% + Environment at a call site,\n% + Arguments in function calls,\n% + Return parameters of function definitions\n%\n% Resource use attributes are \"passed\" around by constructions,\n% deconstructions, assignments and so on.\n%\n% The type checker introduces resource use attributes into the type system\n% only at those places resources are required, at other places it ignores\n% them. Then the solver propagates that information around. Therefore\n% within the type system resource annotations mean \"this is the set of\n% resources that this function may need\", and not \"might have access to\".\n% Then this module checks the locations where resources are provided,\n% ensuring that all the required resources (on the type annotation) are\n% provided by the environment or anther type.\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module io.\n\n:- import_module compile_error.\n:- import_module util.log.\n:- import_module util.result.\n\n:- pred res_check(log_config::in, errors(compile_error)::out,\n core::in, core::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module require.\n\n:- import_module context.\n:- import_module core.util.\n:- import_module util.mercury.\n\n%-----------------------------------------------------------------------%\n\nres_check(Verbose, Errors, !Core, !IO) :-\n process_noerror_funcs(Verbose, res_check_func, Errors, !Core, !IO).\n\n:- pred res_check_func(core::in, func_id::in, function::in,\n result_partial(function, compile_error)::out) is det.\n\nres_check_func(Core, _FuncId, Func0, Result) :-\n func_get_resource_signature(Func0, Using, Observing),\n ( if\n func_get_body(Func0, Varmap, Params, Captured, Expr0),\n func_get_vartypes(Func0, VarTypes)\n then\n Info = check_res_info(Core, Using, Observing, VarTypes),\n res_check_expr(Info, Expr0, Expr, ExprResult),\n func_set_body(Varmap, Params, Captured, Expr, VarTypes, Func0, Func)\n else\n unexpected($file, $pred, \"Couldn't lookup function body or types\")\n ),\n\n func_get_type_signature(Func, _, OutputTypes, _),\n ExprTypes = code_info_types(Expr ^ e_info),\n Context = func_get_context(Func),\n OutputErrors = foldl((func(MbE, Es) = maybe_cord(MbE) ++ Es),\n map_corresponding(check_output_res(Core, Context),\n OutputTypes, ExprTypes),\n init),\n\n ( ExprResult = ok(_),\n ( if not has_fatal_errors(OutputErrors) then\n Result = ok(Func, OutputErrors)\n else\n Result = errors(OutputErrors)\n )\n ; ExprResult = errors(ExprErrors),\n Result = errors(ExprErrors ++ OutputErrors)\n ).\n\n:- func check_output_res(core, context, type_, type_) =\n maybe(error(compile_error)).\n\ncheck_output_res(Core, Context, TypeRequire, TypeProvide) = MaybeError :-\n ( if\n TypeRequire = func_type(_, _, UsesRequire, ObservesRequire),\n TypeProvide = func_type(_, _, UsesProvide, ObservesProvide)\n then\n ( if\n all_resources_in_parent(Core, UsesRequire, UsesProvide),\n all_resources_in_parent(Core, ObservesRequire,\n ObservesProvide `union` UsesProvide)\n then\n MaybeError = no\n else\n MaybeError = yes(error(Context, ce_resource_unavailable_output))\n )\n else\n % Don't do any stricter tests, the type checker will have done\n % them.\n MaybeError = no\n ).\n\n:- type check_res_info\n ---> check_res_info(\n cri_core :: core,\n cri_using :: set(resource_id),\n cri_observing :: set(resource_id),\n cri_vartypes :: map(var, type_)\n ).\n\n:- pred res_check_expr(check_res_info::in, expr::in, expr::out,\n result(bang_marker, compile_error)::out) is det.\n\nres_check_expr(Info, Expr0, Expr, Result) :-\n Expr0 = expr(ExprType0, CodeInfo0),\n (\n ( ExprType0 = e_var(_)\n ; ExprType0 = e_construction(_, _)\n ; ExprType0 = e_constant(_)\n ; ExprType0 = e_closure(_, _)\n ),\n Result = ok(no_bang_marker),\n Expr = Expr0\n ;\n ( ExprType0 = e_tuple(Exprs0),\n map2(res_check_expr(Info), Exprs0, Exprs, Results0),\n ExprType = e_tuple(Exprs)\n ; ExprType0 = e_lets(Lets0, InExpr0),\n map2(res_check_let(Info), Lets0, Lets, LetsResults),\n res_check_expr(Info, InExpr0, InExpr, InResult),\n Results0 = [InResult | LetsResults],\n ExprType = e_lets(Lets, InExpr)\n ; ExprType0 = e_match(Var, Cases0),\n map2(res_check_case(Info), Cases0, Cases, Results0),\n ExprType = e_match(Var, Cases)\n ),\n\n % On these nodes we must propagate the bang information from inner\n % expressions to outer ones.\n Results = result_list_to_result(Results0),\n ( Results = ok(InnerBangs),\n ( if any_true(unify(has_bang_marker), InnerBangs) then\n code_info_set_bang_marker(has_bang_marker, CodeInfo0,\n CodeInfo),\n Result = ok(has_bang_marker)\n else\n CodeInfo = CodeInfo0,\n Result = ok(no_bang_marker)\n )\n ; Results = errors(InnerErrors),\n Result = errors(InnerErrors),\n CodeInfo = CodeInfo0\n ),\n Expr = expr(ExprType, CodeInfo)\n ; ExprType0 = e_call(Callee, Args, Resources),\n Expr = Expr0,\n % Check that the call has all the correct resources available for\n % this callee.\n ( Resources = unknown_resources,\n unexpected($file, $pred, \"Missing resource usage information\")\n ; Resources = resources(Using, Observing),\n CallResult = res_check_call(Info, CodeInfo0, Using, Observing)\n ),\n\n ( Callee = c_plain(FuncId),\n core_get_function_det(Info ^ cri_core, FuncId, Func),\n func_get_type_signature(Func, InputParams, _, _)\n ; Callee = c_ho(HOVar),\n HOType = lookup(Info ^ cri_vartypes, HOVar),\n ( if HOType = func_type(InputParamsP, _, _, _) then\n InputParams = InputParamsP\n else\n unexpected($file, $pred, \"Call to non-function\")\n )\n ),\n Context = code_info_context(CodeInfo0),\n ArgsErrors = cord_list_to_cord(map_corresponding(\n res_check_call_arg(Info, Context), InputParams, Args)),\n ( if is_empty(ArgsErrors) then\n Result = CallResult\n else\n ( CallResult = ok(_),\n Result = errors(ArgsErrors)\n ; CallResult = errors(Errors),\n Result = errors(Errors ++ ArgsErrors)\n )\n )\n ).\n\n:- pred res_check_let(check_res_info::in, expr_let::in, expr_let::out,\n result(bang_marker, compile_error)::out) is det.\n\nres_check_let(Info, e_let(Var, Expr0), e_let(Var, Expr), Result) :-\n res_check_expr(Info, Expr0, Expr, Result).\n\n:- pred res_check_case(check_res_info::in, expr_case::in, expr_case::out,\n result(bang_marker, compile_error)::out) is det.\n\nres_check_case(Info, e_case(Pat, Expr0), e_case(Pat, Expr), Result) :-\n res_check_expr(Info, Expr0, Expr, Result).\n\n:- func res_check_call(check_res_info, code_info,\n set(resource_id), set(resource_id)) = result(bang_marker, compile_error).\n\nres_check_call(Info, CodeInfo, CalleeUsing, CalleeObserving) = Result :-\n some [!Errors] (\n !:Errors = init,\n FuncUsing = Info ^ cri_using,\n FuncObserving = Info ^ cri_observing,\n Core = Info ^ cri_core,\n Bang = code_info_bang_marker(CodeInfo),\n Context = code_info_context(CodeInfo),\n ( if\n all_resources_in_parent(Core, CalleeUsing, FuncUsing),\n all_resources_in_parent(Core, CalleeObserving,\n FuncUsing `union` FuncObserving)\n then\n true\n else\n add_error(Context, ce_resource_unavailable_call, !Errors)\n ),\n ( if is_empty(CalleeUsing `union` CalleeObserving) then\n ( Bang = has_bang_marker,\n add_error(Context, ce_unnecessary_bang, !Errors)\n ; Bang = no_bang_marker\n )\n else\n ( Bang = has_bang_marker\n ; Bang = no_bang_marker,\n add_error(Context, ce_no_bang, !Errors)\n )\n ),\n ( if is_empty(!.Errors) then\n Result = ok(Bang)\n else\n Result = errors(!.Errors)\n )\n ).\n\n:- func res_check_call_arg(check_res_info, context, type_, var) =\n errors(compile_error).\n\nres_check_call_arg(Info, Context, Param, ArgVar) =\n res_check_call_arg_types(Info ^ cri_core, Context, Param, Arg) :-\n Arg = lookup(Info ^ cri_vartypes, ArgVar).\n\n:- func res_check_call_arg_types(core, context, type_, type_) =\n errors(compile_error).\n\nres_check_call_arg_types(_, _, builtin_type(_), _) = init.\nres_check_call_arg_types(Core, Context, func_type(_ParamInputs, _ParamOutputs,\n ParamUses, ParamObserves), Arg) = Errors :-\n ( if Arg = func_type(ArgInputs, ArgOutputs, ArgUses, ArgObserves) then\n ( if\n all_resources_in_parent(Core, ArgUses, ParamUses),\n all_resources_in_parent(Core, ArgObserves,\n ParamUses `union` ParamObserves)\n then\n FuncErrors = init\n else\n FuncErrors = error(Context, ce_resource_unavailable_arg)\n ),\n\n % TODO: Need to figure this out later.\n ( if\n ( member(Type, ArgInputs)\n ; member(Type, ArgOutputs)\n ),\n is_or_has_function_type_with_resource(Type)\n then\n my_exception.sorry($file, $pred, Context, \"Nested function types\")\n else\n true\n ),\n\n Errors = FuncErrors\n else\n unexpected($file, $pred, \"Types don't match\")\n ).\nres_check_call_arg_types(_, _, type_variable(_), _) = init.\nres_check_call_arg_types(Core, Context, type_ref(_, Params), Arg) = Errors :-\n ( if Arg = type_ref(_, Args) then\n Errors = cord_list_to_cord(map_corresponding(\n res_check_call_arg_types(Core, Context), Params, Args))\n else\n unexpected($file, $pred, \"Types don't match\")\n ).\n\n:- pred is_or_has_function_type_with_resource(type_::in) is semidet.\n\nis_or_has_function_type_with_resource(\n func_type(InputTypes, OutputTypes, Uses, Observes)) :-\n ( not is_empty(Uses)\n ; not is_empty(Observes)\n ;\n member(Arg, InputTypes),\n is_or_has_function_type_with_resource(Arg)\n ;\n member(Arg, OutputTypes),\n is_or_has_function_type_with_resource(Arg)\n ).\nis_or_has_function_type_with_resource(type_ref(_, Args)) :-\n member(Arg, Args),\n is_or_has_function_type_with_resource(Arg).\n\n%-----------------------------------------------------------------------%\n\n:- pred all_resources_in_parent(core::in, set(resource_id)::in,\n set(resource_id)::in) is semidet.\n\nall_resources_in_parent(Core, CalleeRes, FuncRes) :-\n all [C] ( member(C, CalleeRes) => (\n is_non_empty(FuncRes),\n ( member(C, FuncRes)\n ;\n CR = core_get_resource(Core, C),\n some [F] ( member(F, FuncRes) =>\n resource_is_decendant(Core, CR, F)\n )\n ))\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.resource.m", "content": "%-----------------------------------------------------------------------%\n% Plasma types representation\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module core.resource.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module context.\n:- import_module common_types.\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\n:- type resource\n ---> r_io\n ; r_other(\n ro_name :: q_name,\n ro_from :: resource_id,\n ro_sharing :: sharing_opaque,\n ro_imported :: imported,\n ro_context :: context\n )\n % A resource imported from another module, this may only exist\n % during interface generation.\n ; r_abstract(q_name).\n\n:- func resource_to_string(resource) = string.\n\n:- pred resource_is_decendant(core::in, resource::in, resource_id::in)\n is semidet.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module builtins.\n\n%-----------------------------------------------------------------------%\n\nresource_to_string(r_io) =\n q_name_to_string(q_name_append(builtin_module_name, nq_name_det(\"IO\"))).\nresource_to_string(r_other(Symbol, _, _, _, _)) = q_name_to_string(Symbol).\nresource_to_string(r_abstract(Symbol)) = q_name_to_string(Symbol).\n\nresource_is_decendant(_, r_io, _) :- false.\nresource_is_decendant(Core, r_other(_, Parent, _, _, _), Ancestor) :-\n (\n Parent = Ancestor\n ;\n resource_is_decendant(Core, core_get_resource(Core, Parent), Ancestor)\n ).\n\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.simplify.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core.simplify.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT see ../LICENSE.code\n%\n% Plasma simplifcation step\n%\n% This compiler stage does a simplification pass.\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module io.\n\n:- import_module util.log.\n\n:- import_module compile_error.\n:- import_module util.result.\n\n:- pred simplify(log_config::in, errors(compile_error)::out,\n core::in, core::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module require.\n\n:- import_module core.util.\n\n%-----------------------------------------------------------------------%\n\nsimplify(Verbose, Errors, !Core, !IO) :-\n % Simplify expressions\n process_noerror_funcs(Verbose, simplify_func, Errors, !Core, !IO),\n\n % Find dead code. For now all local functions are considered alive so\n % that we can test the code generator, even if they're not called. In\n % the future we can optimise them out.\n AllFuncs = core_all_functions_set(!.Core),\n LocalFuncs = core_all_defined_functions_set(!.Core),\n MaybeDeadFuncs = AllFuncs `difference` LocalFuncs,\n AliveFuncs = union_list(map(find_used_funcs(!.Core),\n set.to_sorted_list(LocalFuncs))),\n DeadFuncs = MaybeDeadFuncs `difference` AliveFuncs,\n foldl(mark_function_dead, to_sorted_list(DeadFuncs), !Core).\n\n%-----------------------------------------------------------------------%\n\n:- pred simplify_func(core::in, func_id::in, function::in,\n result_partial(function, compile_error)::out) is det.\n\nsimplify_func(_Core, _FuncId, !.Func, ok(!:Func, init)) :-\n ( if\n func_get_body(!.Func, Varmap, Params, Captured, Expr0)\n then\n simplify_expr(map.init, Expr0, Expr),\n func_set_body(Varmap, Params, Captured, Expr, !Func)\n else\n unexpected($file, $pred, \"Body missing\")\n ).\n\n:- pred simplify_expr(map(var, var)::in, expr::in, expr::out) is det.\n\nsimplify_expr(Renaming, !Expr) :-\n ExprType = !.Expr ^ e_type,\n ( ExprType = e_tuple(Exprs0),\n map(simplify_expr(Renaming), Exprs0, Exprs),\n ( if Exprs = [Expr] then\n !:Expr = Expr\n else\n !Expr ^ e_type := e_tuple(Exprs)\n )\n ; ExprType = e_lets(Lets0, InExpr0),\n simplify_lets(Lets0, [], Lets, Renaming, RenamingIn),\n rename_expr(RenamingIn, InExpr0, InExpr1),\n simplify_expr(init, InExpr1, InExpr),\n !:Expr = simplify_let(Lets, InExpr, !.Expr ^ e_info)\n ; ExprType = e_call(_, _, _)\n ; ExprType = e_var(_)\n ; ExprType = e_constant(_)\n ; ExprType = e_construction(_, _)\n ; ExprType = e_closure(_, _)\n ; ExprType = e_match(Vars, Cases0),\n map(simplify_case(Renaming), Cases0, Cases),\n !Expr ^ e_type := e_match(Vars, Cases)\n ).\n\n:- pred maybe_fixup_moved_info(code_info::in, expr::in, expr::out) is det.\n\nmaybe_fixup_moved_info(InInfo, !Expr) :-\n ( if code_info_origin(InInfo) = o_user_return(Context) then\n % If this expression was created when preparing a return\n % statement fixup the code info to point to the return\n % statement.\n code_info_set_origin(o_user_return(Context),\n !.Expr ^ e_info, Info),\n !Expr ^ e_info := Info\n else\n true\n ).\n\n% TODO:\n% * Remove single-use variables\n:- pred simplify_lets(list(expr_let)::in, list(expr_let)::in,\n list(expr_let)::out, map(var, var)::in, map(var, var)::out) is det.\n\nsimplify_lets([], !Lets, !Renamings) :-\n reverse(!Lets).\nsimplify_lets([L | Ls0], !RevLets, !Renamings) :-\n L = e_let(Vars, Expr0),\n simplify_expr(!.Renamings, Expr0, Expr1),\n rename_expr(!.Renamings, Expr1, Expr),\n ( if is_empty_tuple_expr(Expr) then\n expect(unify(Vars, []), $file, $pred, \"Bad empty let\"),\n % Discard L\n Ls = Ls0\n else if Expr = expr(e_tuple(Exprs), _) then\n Lets = map_corresponding(func(V, E) = e_let([V], E), Vars, Exprs),\n Ls = Lets ++ Ls0\n else if Expr = expr(e_lets(InnerLets, InnerExpr), _) then\n % Flattern inner lets.\n Ls = InnerLets ++ [e_let(Vars, InnerExpr)] ++ Ls0\n else if\n Vars = [VarDup],\n Expr = expr(e_var(VarOrig), _)\n then\n % We can drop this variable assignment by renaming the new variable\n % in the following expressions.\n map.det_insert(VarDup, VarOrig, !Renamings),\n Ls = Ls0\n else\n Ls = Ls0,\n !:RevLets = [e_let(Vars, Expr) | !.RevLets]\n ),\n simplify_lets(Ls, !RevLets, !Renamings).\n\n:- func simplify_let(list(expr_let), expr, code_info) = expr.\n\nsimplify_let(Lets, InExpr, Info) = !:Expr :-\n InInfo = InExpr ^ e_info,\n ( if\n Lets = []\n then\n !:Expr = InExpr,\n maybe_fixup_moved_info(InInfo, !Expr)\n else if\n is_empty_tuple_expr(InExpr),\n Lets = [e_let([], LetExpr)]\n then\n !:Expr = LetExpr,\n maybe_fixup_moved_info(InInfo, !Expr)\n else if\n is_empty_tuple_expr(InExpr),\n split_last(Lets, OtherLets, e_let([], LetExpr))\n then\n % If LetExpr is also an empty tuple we would want to optimise\n % further. But the simplification above will prevent that.\n !:Expr = expr(e_lets(OtherLets, LetExpr), Info),\n maybe_fixup_moved_info(InInfo, !Expr),\n maybe_simplify_let_again(!Expr)\n else if\n % If the last let binds the same list of variables that is\n % returned by InExpr. Then we can optimise that binding and\n % variables away. A more general optimisation might be able to\n % reorder code to make this possible, we don't attempt that yet.\n is_vars_expr(InExpr, Vars),\n split_last(Lets, OtherLets, e_let(Vars, LetExpr))\n then\n !:Expr = expr(e_lets(OtherLets, LetExpr), Info),\n maybe_fixup_moved_info(InInfo, !Expr),\n maybe_simplify_let_again(!Expr)\n else\n !:Expr = expr(e_lets(Lets, InExpr), Info)\n ).\n\n % Try another round of simplification. Sometimes reducing the let can\n % make some further optimsation possible.\n %\n:- pred maybe_simplify_let_again(expr::in, expr::out) is det.\n\nmaybe_simplify_let_again(expr(ExprType, Info), Expr) :-\n ( ExprType = e_lets(Lets, InExpr),\n Expr = simplify_let(Lets, InExpr, Info)\n ;\n ( ExprType = e_tuple(_)\n ; ExprType = e_call(_, _, _)\n ; ExprType = e_var(_)\n ; ExprType = e_constant(_)\n ; ExprType = e_construction(_, _)\n ; ExprType = e_closure(_, _)\n ; ExprType = e_match(_, _)\n ),\n Expr = expr(ExprType, Info)\n ).\n\n:- pred simplify_case(map(var, var)::in, expr_case::in, expr_case::out) is det.\n\nsimplify_case(Renaming, e_case(Pat, !.Expr), e_case(Pat, !:Expr)) :-\n simplify_expr(Renaming, !Expr).\n\n%-----------------------------------------------------------------------%\n\n:- pred is_empty_tuple_expr(expr::in) is semidet.\n\nis_empty_tuple_expr(Expr) :-\n Expr = expr(e_tuple([]), _).\n\n:- pred is_vars_expr(expr::in, list(var)::out) is semidet.\n\nis_vars_expr(expr(e_tuple(InnerExprs), _), condense(Vars)) :-\n map(is_vars_expr, InnerExprs, Vars).\nis_vars_expr(expr(e_var(Var), _), [Var]).\n\n%-----------------------------------------------------------------------%\n\n:- func find_used_funcs(core, func_id) = set(func_id).\n\nfind_used_funcs(Core, FuncId) = Callees :-\n core_get_function_det(Core, FuncId, Func),\n Callees = func_get_callees(Func).\n\n:- pred mark_function_dead(func_id::in, core::in, core::out) is det.\n\nmark_function_dead(FuncId, !Core) :-\n some [!Func] (\n core_get_function_det(!.Core, FuncId, !:Func),\n func_set_used(unused, !Func),\n core_set_function(FuncId, !.Func, !Core)\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.type_chk.m", "content": "%-----------------------------------------------------------------------%\n% Plasma typechecking\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT see ../LICENSE.code\n%\n% This module typechecks plasma core using a solver over Prolog-like terms.\n% Solver variables and constraints are created as follows.\n%\n% Consider an expression which performs a list cons:\n%\n% cons(elem, list)\n%\n% cons is declared as func(t, List(t)) -> List(t)\n%\n% + Because we use an ANF-like representation associating a type with each\n% variable is almost sufficient, we also associate types with calls. Each\n% type is represented by a solver variable. In this example these are:\n% elem, list and the call to cons. Each of these can have constraints\n% thate describe any type information we already know:\n% elem = int\n% list = T0\n% call(cons) = func(T1, list(T1)) -> list(T1) % based on declaration\n% T1 = int % from function application\n% list(T1) = T0\n%\n% We assume that cons's type is fixed and will not be inferred by this\n% invocation of the solver. Other cases are handled seperately.\n%\n% The new type variable, and therefore solver variable, T1, is introduced.\n% T0 is also introduced to stand in for the type of the list.\n%\n% + The solver can combine these rules, unifing them and finding the unique\n% solution. Type variables that appear in the signature of the function are\n% allowed to be part of the solution, others are not as that would mean it\n% is ambigiously typed.\n%\n% Other type variables and constraints are.\n%\n% + The parameters and return values of the current function. Including\n% treatment of any type variables.\n%\n% Propagation is probably the only step required to find the correct types.\n% However labeling (search) can also occur. Type variables in the signature\n% must be handled specially, they must not be labeled during search and may\n% require extra rules (WIP).\n%\n%-----------------------------------------------------------------------%\n:- module core.type_chk.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n\n:- import_module compile_error.\n:- import_module util.log.\n:- import_module util.result.\n\n:- pred type_check(log_config::in, errors(compile_error)::out,\n core::in, core::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module map.\n:- import_module require.\n:- import_module string.\n\n:- import_module context.\n:- import_module core.pretty.\n:- import_module core.util.\n:- import_module util.\n:- import_module util.mercury.\n:- import_module util.pretty.\n\n:- include_module core.type_chk.solve.\n:- import_module core.type_chk.solve.\n\n%-----------------------------------------------------------------------%\n\ntype_check(Verbose, Errors, !Core, !IO) :-\n % TODO: Add support for inference, which must be bottom up by SCC.\n process_noerror_scc_funcs(Verbose, typecheck_func, Errors, !Core, !IO).\n\n:- pred typecheck_func(core::in, func_id::in,\n function::in, result_partial(function, compile_error)::out) is det.\n\ntypecheck_func(Core, FuncId, Func0, Result) :-\n % Now do the real typechecking.\n build_cp_func(Core, FuncId, Func0, init, Constraints),\n ( if func_get_varmap(Func0, VarmapPrime) then\n Varmap = VarmapPrime\n else\n unexpected($file, $pred, \"Couldn't retrive varmap\")\n ),\n MaybeMapping = solve(Core, Varmap, func_get_context(Func0), Constraints),\n ( MaybeMapping = ok(Mapping),\n update_types_func(Core, Mapping, Func0, Func),\n Result = ok(Func, init)\n ; MaybeMapping = errors(Errors),\n Result = errors(Errors)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred build_cp_func(core::in, func_id::in, function::in,\n problem::in, problem::out) is det.\n\nbuild_cp_func(Core, FuncId, Func, !Problem) :-\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n % TODO: Fix this once we can typecheck SCCs as it might not make\n % sense anymore.\n FuncName = core_lookup_function_name(Core, FuncId),\n format(\"\\nBuilding typechecking problem for %s\\n\",\n [s(q_name_to_string(FuncName))], !IO)\n ),\n\n func_get_type_signature(Func, InputTypes, OutputTypes, _),\n ( if func_get_body(Func, _, Inputs, _, Expr) then\n some [!TypeVars, !TypeVarSource] (\n !:TypeVars = init_type_vars,\n Context = func_get_context(Func),\n\n start_type_var_mapping(!TypeVars),\n % Determine which type variables are free (universally\n % quantified).\n foldl2(set_free_type_vars(Context), OutputTypes, [],\n ParamFreeVarLits0, !TypeVars),\n foldl2(set_free_type_vars(Context), InputTypes,\n ParamFreeVarLits0, ParamFreeVarLits, !TypeVars),\n post_constraint(make_conjunction_from_lits(ParamFreeVarLits),\n !Problem),\n\n map_foldl3(build_cp_output(Context), OutputTypes, OutputConstrs,\n 0, _, !Problem, !TypeVars),\n map_corresponding_foldl2(build_cp_inputs(Context), InputTypes,\n Inputs, InputConstrs, !Problem, !TypeVars),\n post_constraint(make_conjunction(OutputConstrs ++ InputConstrs),\n !Problem),\n end_type_var_mapping(!TypeVars),\n\n build_cp_expr(Core, Expr, TypesOrVars, !Problem, !TypeVars),\n list.map_foldl(unify_with_output(Context), TypesOrVars,\n Constraints, 0, _),\n\n _ = !.TypeVars, % TODO: Is this needed?\n\n post_constraint(make_conjunction(Constraints), !Problem)\n )\n else\n unexpected($module, $pred, \"Imported pred\")\n ).\n\n:- pred set_free_type_vars(context::in, type_::in,\n list(constraint_literal)::in, list(constraint_literal)::out,\n type_var_map(type_var)::in, type_var_map(type_var)::out) is det.\n\nset_free_type_vars(_, builtin_type(_), !Lits, !TypeVarMap).\nset_free_type_vars(Context, type_variable(TypeVar), Lits, [Lit | Lits],\n !TypeVarMap) :-\n maybe_add_free_type_var(Context, TypeVar, Lit, !TypeVarMap).\nset_free_type_vars(Context, type_ref(_, Args), !Lits, !TypeVarMap) :-\n foldl2(set_free_type_vars(Context), Args, !Lits, !TypeVarMap).\nset_free_type_vars(Context, func_type(Args, Returns, _, _), !Lits,\n !TypeVarMap) :-\n foldl2(set_free_type_vars(Context), Args, !Lits, !TypeVarMap),\n foldl2(set_free_type_vars(Context), Returns, !Lits, !TypeVarMap).\n\n:- pred build_cp_output(context::in, type_::in, constraint::out,\n int::in, int::out, P::in, P::out,\n type_var_map(string)::in, type_var_map(string)::out) is det\n <= var_source(P).\n\nbuild_cp_output(Context, Out, Constraint, !ResNum, !Problem, !TypeVars) :-\n build_cp_type(Context, dont_include_resources, Out, v_output(!.ResNum),\n Constraint, !Problem, !TypeVars),\n !:ResNum = !.ResNum + 1.\n\n:- pred build_cp_inputs(context::in, type_::in, var::in,\n constraint::out, P::in, P::out,\n type_var_map(string)::in, type_var_map(string)::out) is det\n <= var_source(P).\n\nbuild_cp_inputs(Context, Type, Var, Constraint, !Problem, !TypeVars) :-\n build_cp_type(Context, include_resources, Type, v_named(Var), Constraint,\n !Problem, !TypeVars).\n\n:- pred unify_with_output(context::in, type_or_var::in, constraint::out,\n int::in, int::out) is det.\n\nunify_with_output(Context, TypeOrVar, Constraint, !ResNum) :-\n OutputVar = v_output(!.ResNum),\n !:ResNum = !.ResNum + 1,\n ( TypeOrVar = type_(Type),\n Constraint = build_cp_simple_type(Context, Type, OutputVar)\n ; TypeOrVar = var(Var),\n Constraint = make_constraint(cl_var_var(Var, OutputVar, Context))\n ).\n\n % An expressions type is either known directly (and has no holes), or is\n % the given variable's type.\n %\n:- type type_or_var\n ---> type_(simple_type)\n ; var(svar).\n\n:- type simple_type\n ---> builtin_type(builtin_type)\n ; type_ref(type_id).\n\n:- pred build_cp_expr(core::in, expr::in, list(type_or_var)::out,\n problem::in, problem::out, type_vars::in, type_vars::out) is det.\n\nbuild_cp_expr(Core, expr(ExprType, CodeInfo), TypesOrVars, !Problem,\n !TypeVars) :-\n Context = code_info_context(CodeInfo),\n ( ExprType = e_tuple(Exprs),\n map_foldl2(build_cp_expr(Core), Exprs, ExprsTypesOrVars, !Problem,\n !TypeVars),\n TypesOrVars = map(one_item, ExprsTypesOrVars)\n ; ExprType = e_lets(Lets, ExprIn),\n build_cp_expr_lets(Core, Lets, ExprIn, TypesOrVars,\n !Problem, !TypeVars)\n ; ExprType = e_call(Callee, Args, _),\n % Note that we deliberately ignore the resource set on calls here.\n % It is calculated from the callee after type-checking and checked\n % for correctness in a later pass.\n ( Callee = c_plain(FuncId),\n build_cp_expr_call(Core, FuncId, Args, Context,\n TypesOrVars, !Problem, !TypeVars)\n ; Callee = c_ho(HOVar),\n build_cp_expr_ho_call(HOVar, Args, CodeInfo, TypesOrVars,\n !Problem, !TypeVars)\n )\n ; ExprType = e_match(Var, Cases),\n map_foldl2(build_cp_case(Core, Var), Cases, CasesTypesOrVars,\n !Problem, !TypeVars),\n unify_types_or_vars_list(Context, CasesTypesOrVars, TypesOrVars,\n Constraint),\n post_constraint(Constraint, !Problem)\n ; ExprType = e_var(Var),\n TypesOrVars = [var(v_named(Var))]\n ; ExprType = e_constant(Constant),\n build_cp_expr_constant(Core, Context, Constant, TypesOrVars,\n !Problem, !TypeVars)\n ; ExprType = e_construction(CtorIds, Args),\n build_cp_expr_construction(Core, CtorIds, Args, Context, TypesOrVars,\n !Problem, !TypeVars)\n ; ExprType = e_closure(FuncId, Captured),\n build_cp_expr_function(Core, Context, FuncId, Captured, TypesOrVars,\n !Problem, !TypeVars)\n ).\n\n:- pred build_cp_expr_lets(core::in,\n list(expr_let)::in, expr::in, list(type_or_var)::out,\n problem::in, problem::out, type_vars::in, type_vars::out) is det.\n\nbuild_cp_expr_lets(Core, Lets, ExprIn, TypesOrVars, !Problem, !TypeVars) :-\n foldl2(build_cp_expr_let(Core), Lets, !Problem, !TypeVars),\n build_cp_expr(Core, ExprIn, TypesOrVars, !Problem, !TypeVars).\n\n:- pred build_cp_expr_let(core::in, expr_let::in,\n problem::in, problem::out, type_vars::in, type_vars::out) is det.\n\nbuild_cp_expr_let(Core, e_let(Vars, Expr), !Problem, !TypeVars) :-\n build_cp_expr(Core, Expr, LetTypesOrVars, !Problem,\n !TypeVars),\n Context = code_info_context(Expr ^ e_info),\n map_corresponding(\n (pred(Var::in, TypeOrVar::in, Con::out) is det :-\n SVar = v_named(Var),\n ( TypeOrVar = var(EVar),\n Con = make_constraint(cl_var_var(SVar, EVar, Context))\n ; TypeOrVar = type_(Type),\n Con = build_cp_simple_type(Context, Type, SVar)\n )\n ), Vars, LetTypesOrVars, Cons),\n post_constraint(make_conjunction(Cons), !Problem).\n\n:- pred build_cp_expr_call(core::in,\n func_id::in, list(var)::in, context::in,\n list(type_or_var)::out, problem::in, problem::out,\n type_vars::in, type_vars::out) is det.\n\nbuild_cp_expr_call(Core, Callee, Args, Context,\n TypesOrVars, !Problem, !TypeVars) :-\n core_get_function_det(Core, Callee, Function),\n func_get_type_signature(Function, ParameterTypes, ResultTypes, _),\n start_type_var_mapping(!TypeVars),\n map_corresponding_foldl2(unify_param(Context), ParameterTypes, Args,\n ParamsLiterals, !Problem, !TypeVars),\n post_constraint(make_conjunction(ParamsLiterals), !Problem),\n % XXX: need a new type of solver var for ResultSVars, maybe need\n % expression numbers again?\n map_foldl2(unify_or_return_result(Context), ResultTypes,\n TypesOrVars, !Problem, !TypeVars),\n end_type_var_mapping(!TypeVars).\n\n% TODO: We're not carefully handling resources in arguments to higher order\n% calls.\n\n:- pred build_cp_expr_ho_call(var::in, list(var)::in, code_info::in,\n list(type_or_var)::out, problem::in, problem::out,\n type_vars::in, type_vars::out) is det.\n\nbuild_cp_expr_ho_call(HOVar, Args, CodeInfo, TypesOrVars, !Problem,\n !TypeVarSource) :-\n Context = code_info_context(CodeInfo),\n\n new_variables(\"ho_arg\", length(Args), ArgVars, !Problem),\n ParamsConstraints = map_corresponding(\n (func(A, AV) = cl_var_var(v_named(A), AV, Context)),\n Args, ArgVars),\n\n % Need the arity.\n ( if code_info_arity(CodeInfo, Arity) then\n new_variables(\"ho_result\", Arity ^ a_num, ResultVars, !Problem)\n else\n my_exception.sorry($file, $pred, Context,\n format(\"HO call sites either need static type information or \" ++\n \"static arity information, we cannot infer both. \" ++\n \"at %s\",\n [s(context_string(Context))]))\n ),\n\n % The resource checking code in core.res_chk.m will check that the\n % correct resources are available here.\n HOVarConstraint = [cl_var_func(v_named(HOVar), ArgVars,\n ResultVars, unknown_resources, Context)],\n post_constraint(\n make_conjunction_from_lits(HOVarConstraint ++ ParamsConstraints),\n !Problem),\n\n TypesOrVars = map(func(V) = var(V), ResultVars).\n\n:- pred build_cp_case(core::in, var::in, expr_case::in, list(type_or_var)::out,\n problem::in, problem::out, type_vars::in, type_vars::out) is det.\n\nbuild_cp_case(Core, Var, e_case(Pattern, Expr), TypesOrVars, !Problem,\n !TypeVarSource) :-\n Context = code_info_context(Expr ^ e_info),\n build_cp_pattern(Core, Context, Pattern, Var, Constraint,\n !Problem, !TypeVarSource),\n post_constraint(Constraint, !Problem),\n build_cp_expr(Core, Expr, TypesOrVars, !Problem, !TypeVarSource).\n\n:- pred build_cp_pattern(core::in, context::in, expr_pattern::in, var::in,\n constraint::out, P::in, P::out, type_vars::in, type_vars::out) is det\n <= var_source(P).\n\nbuild_cp_pattern(_, Context, p_num(_), Var, Constraint,\n !Problem, !TypeVarSource) :-\n Constraint = make_constraint(cl_var_builtin(v_named(Var), int, Context)).\nbuild_cp_pattern(_, Context, p_variable(VarA), Var, Constraint,\n !Problem, !TypeVarSource) :-\n Constraint = make_constraint(\n cl_var_var(v_named(VarA), v_named(Var), Context)).\nbuild_cp_pattern(_, _, p_wildcard, _, make_constraint(cl_true),\n !Problem, !TypeVarSource).\nbuild_cp_pattern(Core, Context, p_ctor(CtorIds, Args), Var, Constraint,\n !Problem, !TypeVarSource) :-\n SVar = v_named(Var),\n map_foldl2((pred(C::in, Ds::out,\n P0::in, P::out, TV0::in, TV::out) is det :-\n core_get_constructor_type(Core, C, Type),\n build_cp_ctor_type(Core, C, SVar, Args, Context, Type,\n Ds, P0, P, TV0, TV)\n ), to_sorted_list(CtorIds), Disjuncts, !Problem, !TypeVarSource),\n Constraint = make_disjunction(Disjuncts).\n\n:- pred build_cp_expr_constant(core::in, context::in, const_type::in,\n list(type_or_var)::out, problem ::in, problem::out,\n type_vars::in, type_vars::out) is det.\n\nbuild_cp_expr_constant(_, Context, c_string(Str), TypesOrVars, !Problem,\n !TypeVars) :-\n ( if count_codepoints(Str) = 1 then\n % This could be a string or a single character.\n new_variable(\"string_or_codepoint\", Var, !Problem),\n post_constraint(make_disjunction([\n make_constraint(cl_var_builtin(Var, string, Context)),\n make_constraint(cl_var_builtin(Var, codepoint, Context))]),\n !Problem),\n TypesOrVars = [var(Var)]\n else\n TypesOrVars = [type_(builtin_type(string))]\n ).\nbuild_cp_expr_constant(_, _, c_number(_), [type_(builtin_type(int))],\n !Problem, !TypeVars).\nbuild_cp_expr_constant(Core, Context, c_func(FuncId), TypesOrVars,\n !Problem, !TypeVars) :-\n build_cp_expr_function(Core, Context, FuncId, [], TypesOrVars, !Problem,\n !TypeVars).\nbuild_cp_expr_constant(_, _, c_ctor(_), _, !Problem, !TypeVars) :-\n % These should be handled by e_construction nodes. Even those that are\n % constant (for now).\n unexpected($file, $pred, \"Constructor\").\n\n:- pred build_cp_expr_construction(core::in,\n set(ctor_id)::in, list(var)::in, context::in, list(type_or_var)::out,\n problem::in, problem::out, type_vars::in, type_vars::out) is det.\n\nbuild_cp_expr_construction(Core, CtorIds, Args, Context, TypesOrVars,\n !Problem, !TypeVars) :-\n new_variable(\"Constructor expression\", SVar, !Problem),\n TypesOrVars = [var(SVar)],\n\n map_foldl2((pred(C::in, Ds::out,\n P0::in, P::out, TV0::in, TV::out) is det :-\n core_get_constructor_type(Core, C, Type),\n build_cp_ctor_type(Core, C, SVar, Args, Context, Type,\n Ds, P0, P, TV0, TV)\n ), to_sorted_list(CtorIds), Disjuncts, !Problem, !TypeVars),\n post_constraint(make_disjunction(Disjuncts), !Problem).\n\n:- pred build_cp_expr_function(core::in, context::in, func_id::in,\n list(var)::in, list(type_or_var)::out, problem ::in, problem::out,\n type_vars::in, type_vars::out) is det.\n\nbuild_cp_expr_function(Core, Context, FuncId, Captured, [var(SVar)], !Problem,\n !TypeVars) :-\n new_variable(\"Function\", SVar, !Problem),\n core_get_function_det(Core, FuncId, Func),\n\n func_get_type_signature(Func, InputTypes, OutputTypes, _),\n start_type_var_mapping(!TypeVars),\n map2_foldl2(build_cp_type_anon(\"HO Arg\", Context), InputTypes,\n InputTypeVars, InputConstraints, !Problem, !TypeVars),\n map2_foldl2(build_cp_type_anon(\"HO Result\", Context), OutputTypes,\n OutputTypeVars, OutputConstraints, !Problem, !TypeVars),\n\n MaybeCapturedTypes = func_maybe_captured_vars_types(Func),\n ( MaybeCapturedTypes = yes(CapturedTypes),\n map_corresponding_foldl2(build_cp_type(Context, include_resources),\n CapturedTypes, map(func(V) = v_named(V), Captured),\n CapturedConstraints, !Problem, !TypeVars)\n ; MaybeCapturedTypes = no,\n CapturedConstraints = []\n ),\n\n end_type_var_mapping(!TypeVars),\n\n func_get_resource_signature(Func, Uses, Observes),\n Resources = resources(Uses, Observes),\n\n Constraint = make_constraint(cl_var_func(SVar, InputTypeVars,\n OutputTypeVars, Resources, Context)),\n post_constraint(\n make_conjunction([Constraint |\n CapturedConstraints ++ OutputConstraints ++ InputConstraints]),\n !Problem).\n\n%-----------------------------------------------------------------------%\n\n:- pred build_cp_ctor_type(core::in, ctor_id::in, svar::in,\n list(var)::in, context::in, type_id::in, constraint::out,\n P::in, P::out, type_vars::in, type_vars::out) is det <= var_source(P).\n\nbuild_cp_ctor_type(Core, CtorId, SVar, Args, Context, TypeId, Constraint,\n !Problem, !TypeVars) :-\n core_get_constructor_det(Core, CtorId, Ctor),\n\n Fields = Ctor ^ c_fields,\n ( if\n length(Fields, N),\n length(Args, N)\n then\n start_type_var_mapping(!TypeVars),\n\n TypeVarNames = Ctor ^ c_params,\n map_foldl(make_type_var, TypeVarNames, TypeVars, !TypeVars),\n\n map_corresponding_foldl2(build_cp_ctor_type_arg(Context), Args,\n Fields, ArgConstraints, !Problem, !TypeVars),\n % TODO: record how type variables are mapped and filled in the type\n % constraint below.\n end_type_var_mapping(!TypeVars),\n\n ResultConstraint = make_constraint(cl_var_usertype(SVar, TypeId,\n TypeVars, Context)),\n Constraint =\n make_conjunction([ResultConstraint | ArgConstraints])\n else\n Constraint = disj([])\n ).\n\n:- pred build_cp_ctor_type_arg(context::in, var::in, type_field::in,\n constraint::out, P::in, P::out,\n type_var_map(type_var)::in, type_var_map(type_var)::out)\n is det <= var_source(P).\n\nbuild_cp_ctor_type_arg(Context, Arg, Field, Constraint,\n !Problem, !TypeVarMap) :-\n Type = Field ^ tf_type,\n ArgVar = v_named(Arg),\n ( Type = builtin_type(Builtin),\n Constraint = make_constraint(cl_var_builtin(ArgVar, Builtin, Context))\n ; Type = type_ref(TypeId, Args),\n new_variables(\"Ctor arg\", length(Args), ArgsVars, !Problem),\n % TODO: Handle type variables nested within deeper type expressions.\n map_corresponding_foldl2(build_cp_type(Context, dont_include_resources),\n Args, ArgsVars, ArgConstraints, !Problem, !TypeVarMap),\n HeadConstraint = make_constraint(cl_var_usertype(ArgVar, TypeId,\n ArgsVars, Context)),\n Constraint = make_conjunction([HeadConstraint | ArgConstraints])\n ; Type = func_type(_, _, _, _),\n my_exception.sorry($file, $pred, Context, \"Function type\")\n ; Type = type_variable(TypeVarStr),\n TypeVar = lookup_type_var(!.TypeVarMap, TypeVarStr),\n Constraint = make_constraint(cl_var_var(ArgVar, TypeVar, Context))\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred unify_types_or_vars_list(context::in, list(list(type_or_var))::in,\n list(type_or_var)::out, constraint::out) is det.\n\nunify_types_or_vars_list(_, [], _, _) :-\n unexpected($file, $pred, \"No cases\").\nunify_types_or_vars_list(Context, [ToVsHead | ToVsTail], ToVs,\n make_conjunction(Constraints)) :-\n unify_types_or_vars_list(Context, ToVsHead, ToVsTail, ToVs, Constraints).\n\n:- pred unify_types_or_vars_list(context::in, list(type_or_var)::in,\n list(list(type_or_var))::in, list(type_or_var)::out,\n list(constraint)::out) is det.\n\nunify_types_or_vars_list(_, ToVs, [], ToVs, []).\nunify_types_or_vars_list(Context, ToVsA, [ToVsB | ToVsTail], ToVs,\n CHeads ++ CTail) :-\n map2_corresponding(unify_type_or_var(Context), ToVsA, ToVsB, ToVs0,\n CHeads),\n unify_types_or_vars_list(Context, ToVs0, ToVsTail, ToVs, CTail).\n\n:- pred unify_type_or_var(context::in, type_or_var::in, type_or_var::in,\n type_or_var::out, constraint::out) is det.\n\nunify_type_or_var(Context, type_(TypeA), ToVB, ToV, Constraint) :-\n ( ToVB = type_(TypeB),\n ( if TypeA = TypeB then\n ToV = type_(TypeA)\n else\n compile_error($file, $pred, \"Compilation error, cannot unify types\")\n ),\n Constraint = make_constraint(cl_true)\n ;\n ToVB = var(Var),\n % It's important to return the var, rather than the type, so that\n % all the types end up getting unified with one-another by the\n % solver.\n ToV = var(Var),\n Constraint = build_cp_simple_type(Context, TypeA, Var)\n ).\nunify_type_or_var(Context, var(VarA), ToVB, ToV, Constraint) :-\n ( ToVB = type_(Type),\n unify_type_or_var(Context, type_(Type), var(VarA), ToV, Constraint)\n ; ToVB = var(VarB),\n ToV = var(VarA),\n ( if VarA = VarB then\n Constraint = make_constraint(cl_true)\n else\n Constraint = make_constraint(cl_var_var(VarA, VarB, Context))\n )\n ).\n\n:- pred unify_param(context::in, type_::in, var::in,\n constraint::out, P::in, P::out,\n type_var_map(string)::in, type_var_map(string)::out) is det\n <= var_source(P).\n\nunify_param(Context, PType, ArgVar, Constraint, !Problem, !TypeVars) :-\n % XXX: Should be using TVarmap to handle type variables correctly.\n build_cp_type(Context, dont_include_resources, PType, v_named(ArgVar),\n Constraint, !Problem, !TypeVars).\n\n:- pred unify_or_return_result(context::in, type_::in,\n type_or_var::out, problem::in, problem::out,\n type_var_map(string)::in, type_var_map(string)::out) is det.\n\nunify_or_return_result(_, builtin_type(Builtin),\n type_(builtin_type(Builtin)), !Problem, !TypeVars).\nunify_or_return_result(_, type_variable(TypeVar),\n var(SVar), !Problem, !TypeVars) :-\n get_or_make_type_var(TypeVar, SVar, !TypeVars).\nunify_or_return_result(Context, Type, var(SVar), !Problem, !TypeVars) :-\n ( Type = type_ref(_, _)\n ; Type = func_type(_, _, _, _)\n ),\n new_variable(\"?\", SVar, !Problem),\n % TODO: Test functions in structures as returns.\n build_cp_type(Context, include_resources, Type, SVar, Constraint,\n !Problem, !TypeVars),\n post_constraint(Constraint, !Problem).\n\n%-----------------------------------------------------------------------%\n\n:- type include_resources\n ---> include_resources\n ; dont_include_resources.\n\n:- pred build_cp_type(context::in, include_resources::in,\n type_::in, svar::in, constraint::out, P::in, P::out,\n type_var_map(string)::in, type_var_map(string)::out) is det <= var_source(P).\n\nbuild_cp_type(Context, _, builtin_type(Builtin), Var,\n make_constraint(cl_var_builtin(Var, Builtin, Context)),\n !Problem, !TypeVarMap).\nbuild_cp_type(Context, _, type_variable(TypeVarStr), Var, Constraint,\n !Problem, !TypeVarMap) :-\n get_or_make_type_var(TypeVarStr, TypeVar, !TypeVarMap),\n Constraint = make_constraint(cl_var_var(Var, TypeVar, Context)).\nbuild_cp_type(Context, IncludeRes, type_ref(TypeId, Args), Var,\n make_conjunction([Constraint | ArgConstraints]),\n !Problem, !TypeVarMap) :-\n build_cp_type_args(Context, IncludeRes, Args, ArgVars, ArgConstraints,\n !Problem, !TypeVarMap),\n Constraint = make_constraint(cl_var_usertype(Var, TypeId, ArgVars,\n Context)).\nbuild_cp_type(Context, IncludeRes,\n func_type(Inputs, Outputs, Uses, Observes), Var,\n make_conjunction(Conjunctions), !Problem, !TypeVarMap) :-\n build_cp_type_args(Context, IncludeRes, Inputs, InputVars,\n InputConstraints, !Problem, !TypeVarMap),\n build_cp_type_args(Context, IncludeRes, Outputs, OutputVars,\n OutputConstraints, !Problem, !TypeVarMap),\n ( IncludeRes = include_resources,\n Resources = resources(Uses, Observes)\n ; IncludeRes = dont_include_resources,\n Resources = unknown_resources\n ),\n Constraint = make_constraint(cl_var_func(Var, InputVars, OutputVars,\n Resources, Context)),\n Conjunctions = [Constraint | InputConstraints ++ OutputConstraints].\n\n:- pred build_cp_type_args(context::in, include_resources::in, list(type_)::in,\n list(svar)::out, list(constraint)::out, P::in, P::out,\n type_var_map(string)::in, type_var_map(string)::out) is det\n <= var_source(P).\n\nbuild_cp_type_args(Context, IncludeRes, Args, Vars, Constraints, !Problem,\n !TypeVarMap) :-\n NumArgs = length(Args),\n new_variables(\"?\", NumArgs, Vars, !Problem),\n map_corresponding_foldl2(build_cp_type(Context, IncludeRes),\n Args, Vars, Constraints, !Problem, !TypeVarMap).\n\n:- func build_cp_simple_type(context, simple_type, svar) = constraint.\n\nbuild_cp_simple_type(Context, builtin_type(Builtin), Var) =\n make_constraint(cl_var_builtin(Var, Builtin, Context)).\nbuild_cp_simple_type(Context, type_ref(TypeId), Var) =\n make_constraint(cl_var_usertype(Var, TypeId, [], Context)).\n\n:- pred build_cp_type_anon(string::in, context::in, type_::in,\n svar::out, constraint::out, P::in, P::out,\n type_var_map(string)::in, type_var_map(string)::out) is det\n <= var_source(P).\n\nbuild_cp_type_anon(Comment, Context, Type, Var, Constraint, !Problem,\n !TypeVars) :-\n new_variable(Comment, Var, !Problem),\n build_cp_type(Context, include_resources, Type, Var, Constraint,\n !Problem, !TypeVars).\n\n%-----------------------------------------------------------------------%\n\n:- pred update_types_func(core::in, map(svar_user, type_)::in,\n function::in, function::out) is det.\n\nupdate_types_func(Core, TypeMap, !Func) :-\n some [!Expr] (\n ( if func_get_body(!.Func, Varmap, Inputs, Captured, !:Expr) then\n func_get_type_signature(!.Func, _, OutputTypes, _),\n update_types_expr(Core, Varmap, TypeMap, at_root_expr,\n OutputTypes, _Types, !Expr),\n\n map.foldl(svar_type_to_var_type_map, TypeMap, map.init, VarTypes),\n func_set_body(Varmap, Inputs, Captured, !.Expr, !Func),\n func_set_vartypes(VarTypes, !Func),\n func_set_captured_vars_types(\n map(map.lookup(VarTypes), Captured), !Func)\n else\n unexpected($file, $pred, \"imported pred\")\n )\n ).\n\n:- pred svar_type_to_var_type_map(svar_user::in, type_::in,\n map(var, type_)::in, map(var, type_)::out) is det.\n\nsvar_type_to_var_type_map(vu_named(Var), Type, !Map) :-\n det_insert(Var, Type, !Map).\nsvar_type_to_var_type_map(vu_output(_), _, !Map).\n\n:- type at_root_expr\n % The expressions type comes from the function outputs, and\n % must have any resources ignored.\n ---> at_root_expr\n ; at_other_expr.\n\n:- pred update_types_expr(core::in, varmap::in, map(svar_user, type_)::in,\n at_root_expr::in, list(type_)::in, list(type_)::out, expr::in, expr::out)\n is det.\n\nupdate_types_expr(Core, Varmap, TypeMap, AtRoot, !Types, !Expr) :-\n !.Expr = expr(ExprType0, CodeInfo0),\n ( ExprType0 = e_tuple(Exprs0),\n map2_corresponding((pred(T0::in, E0::in, T::out, E::out) is det :-\n update_types_expr(Core, Varmap, TypeMap, AtRoot, T0, T,\n E0, E)\n ),\n map(func(T) = [T], !.Types), Exprs0, Types0, Exprs),\n !:Types = map(one_item, Types0),\n ExprType = e_tuple(Exprs)\n ; ExprType0 = e_lets(Lets0, ExprIn0),\n map(update_types_let(Core, Varmap, TypeMap), Lets0, Lets),\n update_types_expr(Core, Varmap, TypeMap, AtRoot, !Types,\n ExprIn0, ExprIn),\n ExprType = e_lets(Lets, ExprIn)\n ; ExprType0 = e_call(Callee, Args, _),\n ( Callee = c_plain(FuncId),\n core_get_function_det(Core, FuncId, Func),\n func_get_resource_signature(Func, Uses, Observes),\n Resources = resources(Uses, Observes)\n ; Callee = c_ho(HOVar),\n lookup(TypeMap, vu_named(HOVar), HOType),\n ( if HOType = func_type(_, _, Uses, Observes) then\n Resources = resources(Uses, Observes)\n else\n unexpected($file, $pred, \"Call to non-function\")\n )\n ),\n ExprType = e_call(Callee, Args, Resources)\n ; ExprType0 = e_match(Var, Cases0),\n % Get the set of e ctor ids for the patterns used here.\n lookup(TypeMap, vu_named(Var), VarType),\n MaybeTypeCtors = map_maybe(list_to_set, type_get_ctors(Core, VarType)),\n\n map2((pred(C0::in, C::out, T::out) is det :-\n update_types_case(Core, Varmap, TypeMap, AtRoot, MaybeTypeCtors,\n !.Types, T, C0, C)\n ), Cases0, Cases, Types0),\n ( if\n Types0 = [TypesP | _],\n all_same(Types0)\n then\n !:Types = TypesP\n else\n unexpected($file, $pred, \"Mismatching types from match arms\")\n ),\n ExprType = e_match(Var, Cases)\n ; ExprType0 = e_var(Var),\n ExprType = ExprType0,\n lookup(TypeMap, vu_named(Var), Type),\n ( if\n !.Types = [TestType],\n require_complete_switch [AtRoot]\n ( AtRoot = at_other_expr,\n TestType \\= Type\n ; AtRoot = at_root_expr,\n \\+ types_equal_except_resources(TestType, Type)\n )\n then\n Pretties = [p_str(\"Types do not match for var: \"),\n var_pretty(Varmap, Var),\n p_expr([p_str(\"passed in: \"),\n type_pretty(Core, TestType)]),\n p_expr([p_str(\"typechecker: \"),\n type_pretty(Core, Type)])],\n unexpected($file, $pred,\n append_list(list(pretty(default_options, 0, Pretties))))\n else\n true\n ),\n !:Types = [Type]\n ; ExprType0 = e_constant(Const),\n ExprType = ExprType0,\n ConstType = const_type(Core, Const),\n % The type inference can't propage resource usage, we need to do that\n % for higher-order values here. It'll then be checked in the\n % resource checking pass.\n % TODO: If it's stored in a structure rather than returned probably\n % doesn't work?\n ( if\n !.Types = [func_type(Inputs, Outputs, _, _)],\n ConstType = func_type(_, _, Use, Observe)\n then\n !:Types = [func_type(Inputs, Outputs, Use, Observe)]\n else\n true\n )\n ; ExprType0 = e_construction(Ctors0, Args),\n ( if !.Types = [CtorType] then\n MaybeTypeCtors = type_get_ctors(Core, CtorType),\n ( MaybeTypeCtors = yes(TypeCtors0),\n TypeCtors = list_to_set(TypeCtors0),\n Ctors = Ctors0 `intersect` TypeCtors,\n ( if count(Ctors) = 1 then\n true\n else\n unexpected($file, $pred, \"matching ctors != 1\")\n ),\n ExprType = e_construction(Ctors, Args)\n ; MaybeTypeCtors = no,\n unexpected($file, $pred,\n \"Construction of a type that should use e_constant \" ++\n \"or is abstract\")\n )\n else\n unexpected($file, $pred, \"Bad arity\")\n )\n ; ExprType0 = e_closure(_, _),\n ExprType = ExprType0\n ),\n code_info_set_types(!.Types, CodeInfo0, CodeInfo),\n !:Expr = expr(ExprType, CodeInfo).\n\n:- pred update_types_let(core::in, varmap::in, map(svar_user, type_)::in,\n expr_let::in, expr_let::out) is det.\n\nupdate_types_let(Core, Varmap, TypeMap, e_let(Vars, Expr0),\n e_let(Vars, Expr)) :-\n map((pred(V::in, T::out) is det :-\n lookup(TypeMap, vu_named(V), T)\n ), Vars, TypesLet),\n update_types_expr(Core, Varmap, TypeMap, at_other_expr, TypesLet, _,\n Expr0, Expr).\n\n:- pred update_types_case(core::in, varmap::in, map(svar_user, type_)::in,\n at_root_expr::in, maybe(set(ctor_id))::in,\n list(type_)::in, list(type_)::out, expr_case::in, expr_case::out) is det.\n\nupdate_types_case(Core, Varmap, TypeMap, AtRoot, MaybePossibleCtors, !Types,\n e_case(Pat0, Expr0), e_case(Pat, Expr)) :-\n ( MaybePossibleCtors = yes(PossibleCtors),\n update_ctors_pattern(PossibleCtors, Pat0, Pat)\n ; MaybePossibleCtors = no,\n % Patterns for these types don't need updating, they don't use\n % constructor IDs.\n Pat = Pat0\n ),\n update_types_expr(Core, Varmap, TypeMap, AtRoot, !Types, Expr0, Expr).\n\n:- pred update_ctors_pattern(set(ctor_id)::in,\n expr_pattern::in, expr_pattern::out) is det.\n\nupdate_ctors_pattern(_, P@p_num(_), P).\nupdate_ctors_pattern(_, P@p_variable(_), P).\nupdate_ctors_pattern(_, p_wildcard, p_wildcard).\nupdate_ctors_pattern(PosCtors, p_ctor(Ctors0, Args), p_ctor(Ctors, Args)) :-\n Ctors = Ctors0 `intersect` PosCtors,\n ( if count(Ctors) = 1 then\n true\n else\n unexpected($file, $pred, \"matching ctors != 1\")\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func const_type(core, const_type) = type_.\n\nconst_type(_, c_string(_)) = builtin_type(string).\nconst_type(_, c_number(_)) = builtin_type(int).\nconst_type(_, c_ctor(_)) =\n my_exception.sorry($file, $pred, \"Bare constructor\").\nconst_type(Core, c_func(FuncId)) = func_type(Inputs, Outputs, Uses, Observes) :-\n core_get_function_det(Core, FuncId, Func),\n func_get_type_signature(Func, Inputs, Outputs, _),\n func_get_resource_signature(Func, Uses, Observes).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.type_chk.solve.m", "content": "%-----------------------------------------------------------------------%\n% Solver for typechecking/inference.\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT see ../LICENSE.code\n%\n% This module implements a FD solver over types.\n%\n% Use MCFLAGS=--trace-flag typecheck_solve to trace this module.\n%\n%-----------------------------------------------------------------------%\n:- module core.type_chk.solve.\n%-----------------------------------------------------------------------%\n:- interface.\n\n% Typechecking requires solving a constraint problem.\n%\n% Each expression in the function is a constraint variable.\n% Each type is a value, as a herbrand constraint.\n%\n% The variables representing the arguments of the function may remain\n% unconstrained, they are polymorphic. If there are no solutions then there\n% is a type error.\n\n:- import_module map.\n\n%-----------------------------------------------------------------------%\n\n:- type svar\n ---> v_named(varmap.var)\n % The type of an output value in this position.\n ; v_output(int)\n ; v_anon(int)\n ; v_type_var(int).\n\n % A subset of the above, just the \"user\" variables, those that the\n % typechecker itself uses.\n %\n:- type svar_user\n ---> vu_named(varmap.var)\n ; vu_output(int).\n\n:- type problem.\n\n:- func init = problem.\n\n% A typeclass is used here to allow callers to restrict the possible things\n% that may be done to a problem. In this case using only this typeclass\n% guarantee that some code won't post new constraints.\n:- typeclass var_source(S) where [\n pred new_variable(string::in, svar::out, S::in, S::out) is det,\n\n pred new_variables(string::in, int::in, list(svar)::out,\n S::in, S::out) is det\n].\n\n:- instance var_source(problem).\n\n:- pred post_constraint(constraint::in, problem::in, problem::out) is det.\n\n%-----------------------------------------------------------------------%\n\n% Constraints are boolean expressions. Literals and their conjunctions and\n% disjunctions. Although an individual constraint is never more complex\n% than disjunctive normal form. This representation and algorithm is\n% simple. But it may be too simple to handle generics well and it is\n% definitely to simple to give useful/helpful type errors.\n\n:- type constraint_literal\n ---> cl_true\n ; cl_var_builtin(svar, builtin_type, context)\n ; cl_var_usertype(svar, type_id, list(svar), context)\n ; cl_var_func(\n clvf_var :: svar,\n clvf_inputs :: list(svar),\n clvf_outputs :: list(svar),\n clvf_resources :: maybe_resources,\n clvf_context :: context\n )\n ; cl_var_free_type_var(svar, type_var, context)\n ; cl_var_var(svar, svar, context).\n\n:- type constraint\n ---> single(constraint_literal)\n ; conj(list(constraint))\n ; disj(list(constraint)).\n\n:- func make_constraint(constraint_literal) = constraint.\n\n % Make the constraint that this variable has one of the given types.\n % In other words this is a disjunction.\n %\n% :- func make_constraint_user_types(set(type_id), svar) = constraint.\n\n:- func make_conjunction_from_lits(list(constraint_literal)) = constraint.\n\n % Make conjunctions and disjunctions and flatten them as they're\n % created..\n %\n:- func make_conjunction(list(constraint)) = constraint.\n\n:- func make_disjunction(list(constraint)) = constraint.\n\n%:- pred post_constraint_abstract(svar::in, type_var::in,\n% problem(V)::in, problem(V)::out) is det.\n%\n% % post_constraint_match(V1, V2, !Problem)\n% %\n% % This constraint is a half-unification, or a pattern match, V1 and V2\n% % must be \"unifiable\", V1 will be updated to match V2, but V2 will not\n% % be updated to match V1. For example:\n% %\n% % f = X => f = X\n% % X = f => f = f\n% %\n% % This is used to make an argument's type (V1) match the parameter\n% % type (V2) without constraining the parameter type.\n% %\n%:- pred post_constraint_match(svar::in, svar::in,\n% problem(V)::in, problem(V)::out) is det.\n\n:- func solve(core, varmap, context, problem) =\n result(map(svar_user, type_), compile_error).\n\n%-----------------------------------------------------------------------%\n%\n% Type variable handling.\n%\n% Type variables are scoped to their declarations. So x in one declaration is\n% a different variable from x in another. While the constraint problem is\n% built, we map these different variables (with or without the same names)\n% to distinct variables in the constraint problem. Therefore we track type\n% variables throughout building the problem but switch to and from building\n% and using a map (as we read each declaration).\n%\n\n:- type type_vars.\n\n:- type type_var_map(T).\n\n:- func init_type_vars = type_vars.\n\n:- pred start_type_var_mapping(type_vars::in, type_var_map(T)::out)\n is det.\n\n:- pred end_type_var_mapping(type_var_map(T)::in, type_vars::out)\n is det.\n\n:- pred get_or_make_type_var(T::in, svar::out, type_var_map(T)::in,\n type_var_map(T)::out) is det.\n\n:- pred make_type_var(T::in, svar::out, type_var_map(T)::in,\n type_var_map(T)::out) is det.\n\n:- func lookup_type_var(type_var_map(T), T) = svar.\n\n:- pred maybe_add_free_type_var(context::in, type_var::in,\n constraint_literal::out,\n type_var_map(type_var)::in, type_var_map(type_var)::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module io.\n:- import_module set.\n:- import_module set_tree234.\n% Use this set when we need better behaviour for larger sets.\n:- type big_set(T) == set_tree234(T).\n:- import_module string.\n\n:- import_module core.pretty.\n:- import_module util.\n\n:- type problem\n ---> problem(\n p_next_anon_var :: int,\n p_var_comments :: map(svar, string),\n % All the constraints one conjunction.\n p_constraints :: list(constraint)\n ).\n\ninit = problem(0, init, []).\n\n:- instance var_source(problem) where [\n (new_variable(Comment, v_anon(Var), !Problem) :-\n Var = !.Problem ^ p_next_anon_var,\n !Problem ^ p_next_anon_var := Var + 1,\n map.det_insert(v_anon(Var), Comment, !.Problem ^ p_var_comments,\n VarComments),\n !Problem ^ p_var_comments := VarComments\n ),\n\n (new_variables(Comment, N, Vars, !Problem) :-\n ( if N > 0 then\n new_variable(format(\"%s no %d\", [s(Comment), i(N)]), V, !Problem),\n new_variables(Comment, N - 1, Vs, !Problem),\n Vars = [V | Vs]\n else\n Vars = []\n ))\n].\n\n%-----------------------------------------------------------------------%\n\npost_constraint(Cons, !Problem) :-\n Conjs0 = !.Problem ^ p_constraints,\n ( Cons = conj(NewConjs),\n Conjs = NewConjs ++ Conjs0\n ;\n ( Cons = single(_)\n ; Cons = disj(_)\n ),\n Conjs = [Cons | Conjs0]\n ),\n !Problem ^ p_constraints := Conjs.\n\n%-----------------------------------------------------------------------%\n\nmake_constraint(Lit) = single(Lit).\n\n%-----------------------------------------------------------------------%\n\nmake_conjunction_from_lits(Lits) =\n make_conjunction(map(func(L) = single(L), Lits)).\n\nmake_conjunction(Conjs) = conj(foldl(make_conjunction_loop, Conjs, [])).\n\n:- func make_conjunction_loop(constraint, list(constraint)) =\n list(constraint).\n\nmake_conjunction_loop(Conj@single(_), Conjs) = [Conj | Conjs].\nmake_conjunction_loop(conj(NewConjs), Conjs) =\n foldl(make_conjunction_loop, NewConjs, Conjs).\nmake_conjunction_loop(Conj@disj(_), Conjs) = [Conj | Conjs].\n\nmake_disjunction(Disjs) = disj(foldl(make_disjunction_loop, Disjs, [])).\n\n:- func make_disjunction_loop(constraint, list(constraint)) =\n list(constraint).\n\nmake_disjunction_loop(Disj@single(_), Disjs) = [Disj | Disjs].\nmake_disjunction_loop(Disj@conj(_), Disjs) = [Disj | Disjs].\nmake_disjunction_loop(disj(NewDisjs), Disjs) =\n foldl(make_disjunction_loop, NewDisjs, Disjs).\n\n%-----------------------------------------------------------------------%\n\n:- type pretty_info\n ---> pretty_info(\n pi_varmap :: varmap,\n pi_core :: core\n ).\n\n:- func pretty_problem(pretty_info, list(constraint)) = list(pretty).\n\npretty_problem(PrettyInfo, Conjs) =\n pretty_constraints(PrettyInfo, Conjs) ++ [p_str(\".\")].\n\n:- func pretty_constraints(pretty_info, list(constraint)) = list(pretty).\n\npretty_constraints(PrettyInfo, Conjs) =\n condense(list_join([[p_str(\",\"), p_nl_hard]],\n map(pretty_constraint(PrettyInfo), Conjs))).\n\n:- func pretty_constraint(pretty_info, constraint) = list(pretty).\n\npretty_constraint(PrettyInfo, single(Lit)) =\n pretty_literal(PrettyInfo, Lit).\npretty_constraint(PrettyInfo, conj(Conjs)) =\n pretty_constraints(PrettyInfo, Conjs).\npretty_constraint(PrettyInfo, disj(Disjs)) =\n [p_str(\"( \"), p_nl_hard] ++\n list_join([p_nl_hard, p_str(\";\"), p_nl_hard],\n map((func(D) = p_expr(pretty_constraint(PrettyInfo, D))), Disjs)) ++\n [p_nl_hard, p_str(\")\")].\n\n:- func pretty_problem_flat(pretty_info, list(clause)) = list(pretty).\n\npretty_problem_flat(PrettyInfo, Conjs) =\n condense(list_join([[p_str(\",\"), p_nl_hard]],\n map(pretty_clause(PrettyInfo), Conjs))) ++ [p_str(\".\")].\n\n:- func pretty_clause(pretty_info, clause) = list(pretty).\n\npretty_clause(PrettyInfo, single(Lit)) =\n pretty_literal(PrettyInfo, Lit).\npretty_clause(PrettyInfo, disj(Lit, Lits)) =\n [p_str(\"(\")] ++\n list_join([p_nl_hard, p_str(\";\"), p_nl_hard],\n map((func(L) = p_expr(pretty_literal(PrettyInfo, L))),\n [Lit | Lits])) ++\n [p_nl_hard, p_str(\")\")].\n\n:- func pretty_literal(pretty_info, constraint_literal) = list(pretty).\n\npretty_literal(_, cl_true) = [p_str(\"true\")].\npretty_literal(PrettyInfo, cl_var_builtin(Var, Builtin, Context)) =\n pretty_context_comment(Context) ++\n [unify(pretty_var(PrettyInfo, Var), p_str(string(Builtin)))].\npretty_literal(PrettyInfo, cl_var_usertype(Var, Usertype, ArgVars, Context)) =\n pretty_context_comment(Context) ++\n [unify(pretty_var(PrettyInfo, Var),\n pretty_user_type(PrettyInfo, Usertype,\n map(pretty_var(PrettyInfo), ArgVars)))].\npretty_literal(PrettyInfo,\n cl_var_func(Var, Inputs, Outputs, MaybeResources, Context)) =\n pretty_context_comment(Context) ++\n [unify(pretty_var(PrettyInfo, Var),\n pretty_func_type(PrettyInfo, map(pretty_var(PrettyInfo), Inputs),\n map(pretty_var(PrettyInfo), Outputs), MaybeResources))].\npretty_literal(PrettyInfo, cl_var_free_type_var(Var, TypeVar, Context)) =\n pretty_context_comment(Context) ++\n [unify(pretty_var(PrettyInfo, Var), p_str(TypeVar))].\npretty_literal(PrettyInfo, cl_var_var(Var1, Var2, Context)) =\n pretty_context_comment(Context) ++\n [unify(pretty_var(PrettyInfo, Var1),\n pretty_var(PrettyInfo, Var2))].\n\n:- func pretty_store(problem_solving) = pretty.\n\npretty_store(problem(Vars, VarComments, Domains, PrettyInfo)) = Pretty :-\n Pretty = p_expr([p_str(\"Store: \"), p_nl_hard] ++ VarDomsPretty),\n VarDomsPretty = pretty_seperated([p_nl_hard],\n map(pretty_var_domain(PrettyInfo, Domains, VarComments),\n to_sorted_list(Vars))).\n\n:- func pretty_var_domain(pretty_info, map(svar, domain), map(svar, string),\n svar) = pretty.\n\npretty_var_domain(PrettyInfo, Domains, VarComments, Var) = Pretty :-\n Pretty = p_expr(\n [unify(pretty_var(PrettyInfo, Var),\n pretty_domain(PrettyInfo, Domain))] ++\n Comment),\n Domain = get_domain(Domains, Var),\n ( if map.search(VarComments, Var, VarComment) then\n Comment = [p_str(\" # \"), p_str(VarComment)]\n else\n Comment = []\n ).\n\n:- func pretty_var(pretty_info, svar) = pretty.\n\npretty_var(PrettyInfo, Var) = p_str(String) :-\n ( Var = v_named(NamedVar),\n Name = get_var_name(PrettyInfo ^ pi_varmap, NamedVar),\n String = format(\"'Sv_%s\", [s(Name)])\n ;\n ( Var = v_output(N),\n Label = \"Output\"\n ; Var = v_anon(N),\n Label = \"Anon\"\n ; Var = v_type_var(N),\n Label = \"TypeVar\"\n ),\n String = format(\"'%s_%d\", [s(Label), i(N)])\n ).\n\n:- func pretty_var_user(pretty_info, svar_user) = pretty.\n\npretty_var_user(PrettyInfo, vu_named(NamedVar)) = p_str(String) :-\n Name = get_var_name(PrettyInfo ^ pi_varmap, NamedVar),\n String = format(\"'Sv_%s\", [s(Name)]).\npretty_var_user(_, vu_output(N)) = p_str(String) :-\n String = format(\"'Output_%d\", [i(N)]).\n\n:- func pretty_domain(pretty_info, domain) = pretty.\n\npretty_domain(_, d_free) = p_str(\"_\").\npretty_domain(_, d_builtin(Builtin)) = p_str(string(Builtin)).\npretty_domain(PrettyInfo, d_type(TypeId, Domains)) =\n pretty_user_type(PrettyInfo, TypeId,\n map(pretty_domain(PrettyInfo), Domains)).\npretty_domain(PrettyInfo, d_func(Inputs, Outputs, MaybeResources)) =\n pretty_func_type(PrettyInfo, map(pretty_domain(PrettyInfo), Inputs),\n map(pretty_domain(PrettyInfo), Outputs), MaybeResources).\npretty_domain(_, d_univ_var(TypeVar)) = p_str(\"'\" ++ TypeVar).\n\n:- func pretty_user_type(pretty_info, type_id, list(pretty)) = pretty.\n\npretty_user_type(PrettyInfo, TypeId, Args) =\n pretty_callish(q_name_pretty_relative(ModuleName, TypeName), Args) :-\n ModuleName = module_name(PrettyInfo ^ pi_core),\n Type = core_get_type(PrettyInfo ^ pi_core, TypeId),\n TypeName = utype_get_name(Type).\n\n:- func pretty_domain_or_svar(pretty_info, svar, domain) = pretty.\n\npretty_domain_or_svar(Info, SVar, Domain) =\n ( if Domain = d_free then\n pretty_var(Info, SVar)\n else\n pretty_domain(Info, Domain)\n ).\n\n:- func pretty_func_type(pretty_info, list(pretty), list(pretty),\n maybe_resources) = pretty.\n\npretty_func_type(PrettyInfo, Inputs, Outputs, MaybeResources)\n = Pretty :-\n Pretty = func_pretty_template(p_str(\"func\"), Inputs, Outputs, PrettyUses,\n PrettyObserves),\n ( MaybeResources = unknown_resources,\n PrettyUses = [],\n PrettyObserves = []\n ; MaybeResources = resources(Uses, Observes),\n Core = PrettyInfo ^ pi_core,\n PrettyUses = map(resource_pretty(Core), to_sorted_list(Uses)),\n PrettyObserves = map(resource_pretty(Core), to_sorted_list(Observes))\n ).\n\n:- func unify(pretty, pretty) = pretty.\n\nunify(A, B) = p_expr([A, p_str(\" = \"), B]).\n\n:- func pretty_context_comment(context) = list(pretty).\n\npretty_context_comment(C) =\n ( if is_nil_context(C) then\n []\n else\n [p_comment(singleton(\"% \"), [p_str(context_string(C))]), p_nl_hard]\n ).\n\n%-----------------------------------------------------------------------%\n\nsolve(Core, Varmap, FuncContext, problem(_, VarComments, Constraints)) =\n Result :-\n PrettyInfo = pretty_info(Varmap, Core),\n Problem0 = problem(AllVars, VarComments, init, PrettyInfo),\n % Flatten to CNF form.\n flattern(Constraints, Clauses, Aliases),\n AllVars = union_list(map(clause_vars, Clauses)),\n\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n Pretties = [p_str(\"Typecheck solver starting\"), p_nl_double,\n p_expr([p_str(\"Problem:\"), p_nl_hard] ++\n pretty_problem(PrettyInfo, sort(Constraints))),\n p_nl_hard,\n p_expr([p_str(\"Aliases:\"), p_nl_hard] ++\n pretty_comma_seperated(\n map(pretty_simple_alias(pretty_var_user(PrettyInfo)),\n Aliases))),\n p_nl_hard,\n p_expr([p_str(\"Flattened problem:\"), p_nl_hard] ++\n pretty_problem_flat(PrettyInfo, Clauses))],\n write_string(pretty_str(Pretties), !IO),\n nl(!IO)\n ),\n\n run_clauses(Clauses, Problem0, Result0),\n ( Result0 = ok(Problem),\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n write_string(\"\\nsolver finished\\n\", !IO)\n ),\n foldl(build_results(Problem ^ ps_domains), AllVars, init, Solution0),\n foldl((pred(simple_alias(A, B)::in, Map0::in, Map::out) is det :-\n map.lookup(Map0, A, V),\n map.det_insert(B, V, Map0, Map)\n ), Aliases, Solution0, Solution),\n Result = ok(Solution)\n ; Result0 = failed(Context, Why),\n Result = return_error(Context,\n ce_type_error(error_from_why_failed(PrettyInfo, Why)))\n ; Result0 = floundering(UnboundVars, FlounderingClauses, Domains),\n ( if\n promise_equivalent_solutions [Context0] (\n clauses_context(FlounderingClauses, Context0),\n \\+ is_nil_context(Context0)\n )\n then\n Context = Context0\n else\n % Use the context of the whole function.\n Context = FuncContext\n ),\n PrettyVars = map(pretty_var_domain(PrettyInfo, Domains, VarComments),\n UnboundVars),\n PrettyClauses = map(\n func(C) = p_expr(pretty_clause(PrettyInfo, C)),\n FlounderingClauses),\n Result = return_error(Context,\n ce_type_floundering(PrettyVars, PrettyClauses))\n ).\n\n:- func error_from_why_failed(pretty_info, why_failed) = type_error.\n\nerror_from_why_failed(PrettyInfo, mismatch(Domain1, Domain2, MaybeWhy0)) =\n type_unification_failed(\n pretty_domain(PrettyInfo, Domain1),\n pretty_domain(PrettyInfo, Domain2), MaybeWhy) :-\n ( MaybeWhy0 = yes(Why),\n MaybeWhy = yes(error_from_why_failed(PrettyInfo, Why))\n ; MaybeWhy0 = no,\n MaybeWhy = no\n ).\nerror_from_why_failed(PrettyInfo, occurs_in_type(OccursVar, UserType, Args)) =\n type_unification_occurs(\n pretty_var(PrettyInfo, OccursVar),\n pretty_user_type(PrettyInfo, UserType,\n map(curry(pretty_domain_or_svar(PrettyInfo)), Args))).\nerror_from_why_failed(PrettyInfo, occurs_in_func(OccursVar, Inputs, Outputs)) =\n type_unification_occurs(\n pretty_var(PrettyInfo, OccursVar),\n pretty_func_type(PrettyInfo,\n map(curry(pretty_domain_or_svar(PrettyInfo)), Inputs),\n map(curry(pretty_domain_or_svar(PrettyInfo)), Outputs),\n unknown_resources)).\n\n % Note that this is probably O(N^2). While the solver itself is\n % O(NlogN). We do this because it simplifies the problem and allows\n % easier tracing of the type checker. The checker also has larger\n % constant factors so we'd need to measure before optimising anyway.\n %\n % The returned list of aliases (to be un-applied in order) contains only\n % those involving user variables. This should not be a problem since\n % those sort before other variables and therefore a normalised list of\n % clauses will place them first, causing substitutions to keep those in\n % the program.\n %\n:- pred flattern(list(constraint)::in, list(clause)::out,\n list(simple_alias(svar_user))::out) is det.\n\nflattern(Constraints, !:Clauses, Aliases) :-\n !:Clauses = to_sorted_list(to_normal_form(conj(Constraints))),\n flattern_2(!Clauses, [], Aliases).\n\n:- pred flattern_2(list(clause)::in, list(clause)::out,\n list(simple_alias(svar_user))::in, list(simple_alias(svar_user))::out)\n is det.\n\nflattern_2(!Clauses, !Aliases) :-\n ( if remove_first_match_map(is_simple_alias, Alias, !Clauses) then\n substitute(Alias, !Clauses),\n simple_alias(To0, From0) = Alias,\n ( if\n svar_to_svar_user(To0, To),\n svar_to_svar_user(From0, From)\n then\n !:Aliases = [simple_alias(To, From) | !.Aliases]\n else\n true\n ),\n foldl(simplify_clause, !.Clauses, init, ClausesSet),\n !:Clauses = to_sorted_list(ClausesSet),\n flattern_2(!Clauses, !Aliases)\n else\n true\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type simple_alias(V)\n ---> simple_alias(V, V).\n\n:- type simple_alias == simple_alias(svar).\n\n:- pred is_simple_alias(clause::in, simple_alias::out) is semidet.\n\nis_simple_alias(single(cl_var_var(Var1, Var2, _)), simple_alias(Var1, Var2)).\n\n:- func pretty_simple_alias(func(V) = pretty, simple_alias(V)) =\n pretty.\n\npretty_simple_alias(PrettyVar, simple_alias(V1, V2)) =\n unify(PrettyVar(V1), PrettyVar(V2)).\n\n:- pred substitute(simple_alias::in, list(clause)::in, list(clause)::out)\n is det.\n\nsubstitute(Alias, !Clauses) :-\n map(substitute_clause(Alias), !Clauses).\n\n:- pred substitute_clause(simple_alias::in, clause::in, clause::out) is det.\n\nsubstitute_clause(Alias, !Clause) :-\n ( !.Clause = single(Lit0),\n substitute_lit(Alias, Lit0, Lit),\n !:Clause = single(Lit)\n ; !.Clause = disj(Lit0, Lits0),\n substitute_lit(Alias, Lit0, Lit),\n map(substitute_lit(Alias), Lits0, Lits),\n !:Clause = disj(Lit, Lits)\n ).\n\n:- pred substitute_lit(simple_alias::in,\n constraint_literal::in, constraint_literal::out) is det.\n\nsubstitute_lit(_, cl_true, cl_true).\nsubstitute_lit(Alias, cl_var_builtin(V0, B, C), cl_var_builtin(V, B, C)) :-\n substitute_var(Alias, V0, V).\nsubstitute_lit(Alias,\n cl_var_usertype(V0, TypeId, Vars0, Context),\n cl_var_usertype(V, TypeId, Vars, Context)) :-\n substitute_var(Alias, V0, V),\n map(substitute_var(Alias), Vars0, Vars).\nsubstitute_lit(Alias,\n cl_var_func(V0, Is0, Os0, Res, C), cl_var_func(V, Is, Os, Res, C)) :-\n substitute_var(Alias, V0, V),\n map(substitute_var(Alias), Is0, Is),\n map(substitute_var(Alias), Os0, Os).\nsubstitute_lit(Alias,\n cl_var_free_type_var(V0, TV, C), cl_var_free_type_var(V, TV, C)) :-\n substitute_var(Alias, V0, V).\nsubstitute_lit(Alias, cl_var_var(Va0, Vb0, C),\n simplify_literal(cl_var_var(Va, Vb, C))) :-\n substitute_var(Alias, Va0, Va),\n substitute_var(Alias, Vb0, Vb).\n\n:- pred substitute_var(simple_alias::in, svar::in, svar::out) is det.\n\nsubstitute_var(simple_alias(V1, V2), V0, V) :-\n ( if V2 = V0 then\n V = V1\n else\n V = V0\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type clause\n ---> single(constraint_literal)\n ; disj(constraint_literal, list(constraint_literal)).\n\n%-----------------------------------------------------------------------%\n\n:- func to_normal_form(constraint) = set(clause).\n\nto_normal_form(single(Lit0)) = Clauses :-\n Lit = simplify_literal(Lit0),\n ( if Lit = cl_true then\n Clauses = set.init\n else\n Clauses = make_singleton_set(single(Lit))\n ).\nto_normal_form(conj(Conjs0)) = union_list(map(to_normal_form, Conjs0)).\nto_normal_form(disj(Disjs0)) = Conj :-\n Disjs1 = map(to_normal_form, Disjs0),\n ( Disjs1 = [],\n unexpected($file, $pred, \"Empty disjunction\")\n ; Disjs1 = [Conj]\n ; Disjs1 = [D | Ds@[_ | _]],\n Conj = foldl(disj_to_nf, Ds, D)\n ).\n\n:- pred simplify_clause(clause::in,\n big_set(clause)::in, big_set(clause)::out) is det.\n\nsimplify_clause(single(Lit0), !Clauses) :-\n Lit = simplify_literal(Lit0),\n ( if Lit = cl_true then\n true\n else\n insert(single(Lit), !Clauses)\n ).\nsimplify_clause(Disj@disj(_, _), !Clauses) :-\n % We don't need to simplify within disjunctions.\n insert(Disj, !Clauses).\n\n % Create the disjunction by combining a pair of disjuncts at a time.\n %\n % It is in the form (A1 /\\ A2 /\\ ...) v (B1 /\\ B2 /\\ ...)\n %\n % We take each literal in the first clause, and factor it into the\n % second clause. Resulting in:\n %\n % (A1 v B1) /\\ (A1 v B2) /\\ (A2 v B1) /\\ (A2 v B2)\n %\n:- func disj_to_nf(set(clause), set(clause)) = set(clause).\n\ndisj_to_nf(ConjsA, ConjsB) = set_cross(disj_to_nf_clause, ConjsA, ConjsB).\n\n:- func set_cross(func(A, B) = C, set(A), set(B)) = set(C).\n\nset_cross(F, As, Bs) =\n union_list(map(\n (func(A) = list_to_set(map((func(B) = F(A, B)), to_sorted_list(Bs)))),\n to_sorted_list(As))).\n\n:- func disj_to_nf_clause(clause, clause) = clause.\n\ndisj_to_nf_clause(single(D1), single(D2)) = disj(D1, [D2]).\ndisj_to_nf_clause(single(D1), disj(D2, Ds3)) = disj(D1, [D2 | Ds3]).\ndisj_to_nf_clause(disj(D1, Ds2), single(D3)) = disj(D1, [D3 | Ds2]).\ndisj_to_nf_clause(disj(D1, Ds2), disj(D3, Ds4)) =\n disj(D1, [D3 | Ds2 ++ Ds4]).\n\n:- func simplify_literal(constraint_literal) = constraint_literal.\n\nsimplify_literal(cl_true) = cl_true.\nsimplify_literal(L@cl_var_builtin(_, _, _)) = L.\nsimplify_literal(L@cl_var_func(_, _, _, _, _)) = L.\nsimplify_literal(L@cl_var_usertype(_, _, _, _)) = L.\nsimplify_literal(L@cl_var_free_type_var(_, _, _)) = L.\nsimplify_literal(cl_var_var(VarA, VarB, Context)) = Literal :-\n compare(C, VarA, VarB),\n ( C = (=),\n Literal = cl_true\n ; C = (<),\n Literal = cl_var_var(VarA, VarB, Context)\n ; C = (>),\n Literal = cl_var_var(VarB, VarA, Context)\n ).\n\n:- pred clauses_context(list(clause)::in, context::out) is nondet.\n\nclauses_context([C | Cs], Context) :-\n (\n ( C = single(Lit),\n literal_context(Lit, Context)\n ; C = disj(Lit, Lits),\n (\n literal_context(Lit, Context)\n ;\n member(L, Lits),\n literal_context(L, Context)\n )\n )\n ;\n clauses_context(Cs, Context)\n ).\n\n:- pred literal_context(constraint_literal::in, context::out) is semidet.\n\nliteral_context(cl_var_builtin(_, _, Context), Context).\nliteral_context(cl_var_usertype(_, _, _, Context), Context).\nliteral_context(cl_var_func(_, _, _, _, Context), Context).\nliteral_context(cl_var_free_type_var(_, _, Context), Context).\nliteral_context(cl_var_var(_, _, Context), Context).\n\n%-----------------------------------------------------------------------%\n\n:- func clause_vars(clause) = set(svar).\n\nclause_vars(single(Lit)) = literal_vars(Lit).\nclause_vars(disj(Lit, Lits)) =\n literal_vars(Lit) `union` union_list(map(literal_vars, Lits)).\n\n:- func literal_vars(constraint_literal) = set(svar).\n\nliteral_vars(cl_true) = init.\nliteral_vars(cl_var_builtin(Var, _, _)) = make_singleton_set(Var).\nliteral_vars(cl_var_func(Var, Inputs, Outputs, _, _)) =\n make_singleton_set(Var) `union` from_list(Inputs) `union`\n from_list(Outputs).\nliteral_vars(cl_var_usertype(Var, _, ArgVars, _)) =\n insert(from_list(ArgVars), Var).\nliteral_vars(cl_var_free_type_var(Var, _, _)) = make_singleton_set(Var).\nliteral_vars(cl_var_var(VarA, VarB, _)) = from_list([VarA, VarB]).\n\n%-----------------------------------------------------------------------%\n\n:- type problem_solving\n ---> problem(\n ps_vars :: set(svar),\n ps_var_comments :: map(svar, string),\n ps_domains :: map(svar, domain),\n ps_pretty_info :: pretty_info\n % Not currently using propagators.\n % p_propagators :: map(svar, set(propagator(V)))\n ).\n\n:- type problem_result\n ---> ok(problem_solving)\n ; failed(context, why_failed)\n ; floundering(list(svar), list(clause), map(svar, domain)).\n\n:- type why_failed\n ---> mismatch(\n wfm_left :: domain,\n wfm_right :: domain,\n wfm_why :: maybe(why_failed)\n )\n ; occurs_in_type(\n wfot_left :: svar,\n wfot_type :: type_id,\n wfot_right :: assoc_list(svar, domain)\n )\n ; occurs_in_func(\n wfof_left :: svar,\n wfof_input :: assoc_list(svar, domain),\n wfof_output :: assoc_list(svar, domain)\n ).\n\n% We're not currently using propagators in the solver.\n% :- type propagator(V)\n% ---> propagator(constraint).\n\n:- pred run_clauses(list(clause)::in,\n problem_solving::in, problem_result::out) is det.\n\nrun_clauses(Clauses, Problem, Result) :-\n run_clauses(Clauses, [], length(Clauses), domains_not_updated, Problem,\n Result).\n\n:- type domains_updated\n ---> domains_not_updated\n ; domains_updated.\n\n % Run the clauses until we can't make any further progress.\n %\n:- pred run_clauses(list(clause)::in, list(clause)::in, int::in,\n domains_updated::in, problem_solving::in, problem_result::out) is det.\n\nrun_clauses([], [], _, _, Problem, ok(Problem)) :-\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n write_string(\"\\nNo more clauses\\n\", !IO)\n ).\nrun_clauses([], Cs@[_ | _], OldLen, Updated, Problem, Result) :-\n Len = length(Cs),\n ( if\n % Before running the delayed clauses we check to see if we are\n % indeed making progress.\n Len < OldLen ;\n Updated = domains_updated\n then\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n format(\"Running %d delayed clauses\\n\", [i(Len)], !IO)\n ),\n run_clauses(reverse(Cs), [], Len, domains_not_updated, Problem, Result)\n else if\n % We can accept the solution if the only unbound variables are\n % potentially existentially quantified. If they aren't then the\n % the typechecker itself will be able to raise an error.\n all [Var] (\n member(Var, Problem ^ ps_vars) =>\n (\n require_complete_switch [Var]\n ( Var = v_anon(_)\n ; Var = v_type_var(_)\n ;\n ( Var = v_named(_)\n ; Var = v_output(_)\n ),\n Ground = groundness(\n get_domain(Problem ^ ps_domains, Var)),\n require_complete_switch [Ground]\n ( Ground = ground\n ; Ground = ground_maybe_resources\n ; Ground = bound_with_holes_or_free,\n false\n )\n )\n )\n )\n then\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n write_string(\"Delayed goals probably don't matter\\n\", !IO)\n ),\n Result = ok(Problem)\n else\n Result = floundering(to_sorted_list(unbound_vars(Problem)), Cs,\n Problem ^ ps_domains)\n ).\nrun_clauses([C | Cs], Delays0, ProgressCheck, Updated0,\n !.Problem, Result) :-\n run_clause(C, Delays0, Delays, Updated0, Updated, !.Problem, ClauseResult),\n ( ClauseResult = ok(!:Problem),\n run_clauses(Cs, Delays, ProgressCheck, Updated, !.Problem, Result)\n ; ClauseResult = failed(_, _),\n Result = ClauseResult\n ; ClauseResult = floundering(_, _, _),\n Result = ClauseResult\n ).\n\n:- pred run_clause(clause::in, list(clause)::in, list(clause)::out,\n domains_updated::in, domains_updated::out,\n problem_solving::in, problem_result::out) is det.\n\nrun_clause(Clause, !Delays, !Updated, Problem0, Result) :-\n ( Clause = single(Lit),\n run_literal(Lit, Success, Problem0, Problem)\n ; Clause = disj(Lit, Lits),\n run_disj([Lit | Lits], Success, Problem0, Problem)\n ),\n ( Success = success_updated,\n Result = ok(Problem),\n !:Updated = domains_updated\n ; Success = success_not_updated,\n Result = ok(Problem0)\n ; Success = failed(Context, Why),\n Result = failed(Context, Why)\n ; Success = failed_disj,\n compile_error($file, $pred, \"Failed disjunction\")\n ;\n ( Success = delayed_updated,\n Result = ok(Problem),\n !:Updated = domains_updated\n ; Success = delayed_not_updated,\n Result = ok(Problem0)\n ),\n !:Delays = [Clause | !.Delays]\n ).\n\n % A disjunction normally needs at least one literal to be true for the\n % disjunction to be true. However for typechecking we want to find a\n % unique solution to the type problem, therefore we need _exactly one_\n % literal to be true.\n %\n % This will not implement choice points, and will only execute\n % disjunctions that we know will not generate choices. If a disjunction\n % would generate a choice then it will be delayed and hopefully executed\n % later.\n %\n % This is broken into two stages, first iterate over the literals until\n % we find the first true one, then iterate over the remaining literals\n % to ensure they're all false. If we find need to update the problem,\n % then delay.\n %\n:- pred run_disj(list(constraint_literal)::in, executed::out,\n problem_solving::in, problem_solving::out) is det.\n\nrun_disj(Disjs, Delayed, !Problem) :-\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n io.write_string(\"Running disjunction\\n\", !IO)\n ),\n run_disj(Disjs, no, Delayed, !Problem),\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n io.write_string(\"Finished disjunction\\n\", !IO)\n ).\n\n:- pred run_disj(list(constraint_literal)::in,\n maybe(constraint_literal)::in, executed::out,\n problem_solving::in, problem_solving::out) is det.\n\nrun_disj([], no, failed_disj, !Problem).\nrun_disj([], yes(Lit), Success, Problem0, Problem) :-\n run_literal(Lit, Success, Problem0, Problem1),\n % Since all the other disjuncts have failed (or don't exist) then we may\n % update the problem, because we have proven that this disjunct\n % is always the only true one.\n ( if is_updated(Success) then\n Problem = Problem1\n else\n Problem = Problem0\n ).\nrun_disj([Lit | Lits], MaybeDelayed, Success, Problem0, Problem) :-\n run_literal(Lit, Success0, Problem0, Problem1),\n (\n ( Success0 = success_updated\n ; Success0 = delayed_updated\n ),\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n write_string(\" disjunct updates domain, delaying\\n\", !IO)\n ),\n ( MaybeDelayed = yes(_),\n Success = delayed_not_updated,\n Problem = Problem0\n ; MaybeDelayed = no,\n % If an item is the last one and it would update the problem\n % and might be true, then it'll eventually be re-executed above.\n run_disj(Lits, yes(Lit), Success, Problem0, Problem)\n )\n ; Success0 = success_not_updated,\n % Switch to checking that the remaining items are false.\n run_disj_all_false(Lits, MaybeDelayed, Problem1, Success),\n Problem = Problem1\n ; Success0 = delayed_not_updated,\n Success = delayed_not_updated,\n Problem = Problem0\n ;\n ( Success0 = failed(_, _) % XXX: Keep the reason.\n ; Success0 = failed_disj\n ),\n run_disj(Lits, MaybeDelayed, Success, Problem0, Problem)\n ).\n\n:- pred run_disj_all_false(list(constraint_literal)::in,\n maybe(constraint_literal)::in, problem_solving::in, executed::out) is det.\n\nrun_disj_all_false([], no, _, success_not_updated).\nrun_disj_all_false([], yes(Lit), Problem, Success) :-\n run_literal(Lit, Success0, Problem, _),\n (\n ( Success0 = success_updated\n ; Success0 = success_not_updated\n ),\n Success = delayed_not_updated\n ;\n ( Success0 = failed(_, _)\n ; Success0 = failed_disj\n ),\n Success = success_not_updated\n ;\n ( Success0 = delayed_not_updated\n ; Success0 = delayed_updated\n ),\n Success = delayed_not_updated\n ).\nrun_disj_all_false([Lit | Lits], MaybeDelayed, Problem, Success) :-\n run_literal(Lit, Success0, Problem, _),\n (\n ( Success0 = success_updated\n ; Success0 = delayed_updated\n ),\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n write_string(\" disjunct would write updates, delaying\\n\", !IO)\n ),\n ( MaybeDelayed = yes(_),\n Success = delayed_not_updated\n ; MaybeDelayed = no,\n run_disj_all_false(Lits, yes(Lit), Problem, Success)\n )\n ; Success0 = success_not_updated,\n unexpected($file, $pred, \"Ambigious types\")\n ; Success0 = delayed_not_updated,\n Success = delayed_not_updated\n ;\n ( Success0 = failed(_, _)\n ; Success0 = failed_disj\n ),\n run_disj_all_false(Lits, MaybeDelayed, Problem, Success)\n ).\n\n:- type executed\n ---> success_updated\n ; success_not_updated\n ; failed(context, why_failed)\n ; failed_disj\n\n % We've updated the problem but something in this constraint\n % can't be run now, so revisit the whole constraint later.\n ; delayed_updated\n\n ; delayed_not_updated.\n\n:- inst executed_no_delay for executed/0\n ---> success_updated\n ; success_not_updated\n ; failed(ground, ground)\n ; failed_disj.\n\n:- pred is_updated(executed::in) is semidet.\n\nis_updated(success_updated).\nis_updated(delayed_updated).\n\n:- pred mark_delayed(executed::in, executed::out) is det.\n\nmark_delayed(success_updated, delayed_updated).\nmark_delayed(success_not_updated, delayed_not_updated).\nmark_delayed(Failed, _) :-\n ( Failed = failed(_, _)\n ; Failed = failed_disj\n ),\n unexpected($file, $pred, \"Cannot delay after failure\").\nmark_delayed(delayed_updated, delayed_updated).\nmark_delayed(delayed_not_updated, delayed_not_updated).\n\n:- pred mark_updated(executed::in, executed::out) is det.\n\nmark_updated(success_updated, success_updated).\nmark_updated(success_not_updated, success_updated).\nmark_updated(Failed, _) :-\n ( Failed = failed(_, _)\n ; Failed = failed_disj\n ),\n unexpected($file, $pred, \"Cannot update after failure\").\nmark_updated(delayed_updated, delayed_updated).\nmark_updated(delayed_not_updated, delayed_updated).\n\n % Run the literal immediately. Directly update domains and add\n % propagators.\n %\n:- pred run_literal(constraint_literal::in, executed::out,\n problem_solving::in, problem_solving::out) is det.\n\nrun_literal(Lit, Success, !Problem) :-\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n PrettyInfo = !.Problem ^ ps_pretty_info,\n PrettyTitle = [p_str(\"Running step\"), p_nl_hard],\n PrettyDomains = pretty_store(!.Problem),\n PrettyRun = p_expr([p_str(\"Run:\"), p_nl_hard] ++\n pretty_literal(PrettyInfo, Lit)),\n io.write_string(pretty_str(\n PrettyTitle ++ [PrettyDomains, p_nl_hard, PrettyRun, p_nl_hard]),\n !IO)\n ),\n run_literal_2(Lit, Success, !Problem),\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n io.format(\" %s\\n\", [s(string(Success))], !IO)\n ).\n\n:- pred run_literal_2(constraint_literal::in, executed::out,\n problem_solving::in, problem_solving::out) is det.\n\nrun_literal_2(cl_true, success_not_updated, !Problem).\nrun_literal_2(Literal, Success, !Problem) :-\n ( Literal = cl_var_builtin(_, _, _)\n ; Literal = cl_var_var(_, _, _)\n ; Literal = cl_var_free_type_var(_, _, _)\n ; Literal = cl_var_func(_, _, _, _, _)\n ; Literal = cl_var_usertype(_, _, _, _)\n ),\n some [!Domains] (\n !:Domains = !.Problem ^ ps_domains,\n PrettyInfo = !.Problem ^ ps_pretty_info,\n ( Literal = cl_var_builtin(LeftVar, Builtin, Context),\n RightDomain = d_builtin(Builtin),\n RightInnerVars = [],\n MaybeOccursInfo = no\n ; Literal = cl_var_var(LeftVar, RightVar0, Context),\n RightDomain = get_domain(!.Domains, RightVar0),\n RightInnerVars = [],\n MaybeOccursInfo = no\n ; Literal = cl_var_free_type_var(LeftVar, TypeVar, Context),\n RightDomain = d_univ_var(TypeVar),\n RightInnerVars = [],\n MaybeOccursInfo = no\n ; Literal = cl_var_func(LeftVar, InputsUnify, OutputsUnify,\n MaybeResourcesUnify, Context),\n InputDomainsUnify = map(get_domain(!.Domains), InputsUnify),\n OutputDomainsUnify = map(get_domain(!.Domains), OutputsUnify),\n RightDomain = d_func(InputDomainsUnify, OutputDomainsUnify,\n MaybeResourcesUnify),\n RightInnerVars = OutputsUnify ++ InputsUnify,\n MaybeOccursInfo = yes(occurs_in_func(LeftVar,\n map_corresponding(pair, InputsUnify, InputDomainsUnify),\n map_corresponding(pair, OutputsUnify, OutputDomainsUnify)))\n ; Literal = cl_var_usertype(LeftVar, TypeUnify, ArgsUnify, Context),\n ArgDomainsUnify = map(get_domain(!.Domains), ArgsUnify),\n RightDomain = d_type(TypeUnify, ArgDomainsUnify),\n RightInnerVars = ArgsUnify,\n MaybeOccursInfo = yes(occurs_in_type(LeftVar, TypeUnify,\n map_corresponding(pair, ArgsUnify, ArgDomainsUnify)))\n ),\n LeftDomain = get_domain(!.Domains, LeftVar),\n\n % RightInnerVars contains the set of vars inside structions on the\n % right. If the var on the left is in this set then the unification\n % is nonsensical.\n ( if\n MaybeOccursInfo = yes(OccursInfo),\n member(LeftVar, RightInnerVars)\n then\n Success = failed(Context, OccursInfo)\n else\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n Pretty = [p_str(\" left: \"),\n pretty_domain(PrettyInfo, LeftDomain),\n p_str(\" right: \"), pretty_domain(PrettyInfo, RightDomain),\n p_nl_hard],\n write_string(pretty_str(Pretty), !IO)\n ),\n Dom = unify_domains(LeftDomain, RightDomain),\n ( Dom = failed(Why),\n Success = failed(Context, Why)\n ; Dom = unified(NewDom, Updated),\n some [!Success] (\n !:Success = success_not_updated,\n ( Updated = delayed,\n mark_delayed(!Success)\n ;\n ( Updated = new_domain,\n set(LeftVar, NewDom, !Domains),\n ( Literal = cl_var_builtin(_, _, _)\n ; Literal = cl_var_free_type_var(_, _, _)\n ; Literal = cl_var_var(_, RightVar, _),\n set(RightVar, NewDom, !Domains)\n ; Literal = cl_var_func(_, InputVars, OutputVars,\n _, _),\n ( if\n NewDom = d_func(InputDoms, OutputDoms, _)\n then\n foldl_corresponding(map.set,\n InputVars, InputDoms, !Domains),\n foldl_corresponding(map.set,\n OutputVars, OutputDoms, !Domains)\n else\n true\n )\n ; Literal = cl_var_usertype(_, _, ArgVars, _),\n ( if NewDom = d_type(_, ArgDomains) then\n foldl_corresponding(map.set,\n ArgVars, ArgDomains, !Domains)\n else\n true\n )\n ),\n !Problem ^ ps_domains := !.Domains,\n mark_updated(!Success)\n ; Updated = old_domain\n ),\n Groundness = groundness(NewDom),\n ( Groundness = bound_with_holes_or_free,\n mark_delayed(!Success)\n ; Groundness = ground_maybe_resources\n ; Groundness = ground\n )\n ),\n Success = !.Success\n ),\n trace [io(!IO), compile_time(flag(\"typecheck_solve\"))] (\n Pretty = [p_str(\" new: \"),\n pretty_domain(PrettyInfo, NewDom),\n p_nl_hard],\n write_string(pretty_str(Pretty), !IO)\n )\n )\n )\n ).\n\n:- func unbound_vars(problem_solving) = set(svar).\n\nunbound_vars(Problem) =\n Problem ^ ps_vars `difference`\n from_list(filter_map((func(V - D) = V is semidet :-\n G = groundness(D),\n ( G = ground_maybe_resources\n ; G = ground\n )\n ), to_assoc_list(Problem ^ ps_domains))).\n\n%-----------------------------------------------------------------------%\n\n:- pred build_results(map(svar, domain)::in, svar::in,\n map(svar_user, type_)::in, map(svar_user, type_)::out) is det.\n\nbuild_results(_, v_anon(_), !Results).\nbuild_results(_, v_type_var(_), !Results). % XXX\nbuild_results(Map, Var, !Results) :-\n ( Var = v_named(V),\n VarUser = vu_named(V)\n ; Var = v_output(N),\n VarUser = vu_output(N)\n ),\n lookup(Map, Var, Domain),\n Type = domain_to_type(Var, Domain),\n det_insert(VarUser, Type, !Results).\n\n:- pred svar_to_svar_user(svar::in, svar_user::out) is semidet.\n\nsvar_to_svar_user(v_named(N), vu_named(N)).\nsvar_to_svar_user(v_output(O), vu_output(O)).\n\n:- func domain_to_type(V, domain) = type_.\n\ndomain_to_type(Var, d_free) =\n unexpected($file, $pred,\n string.format(\"Free variable in '%s'\", [s(string(Var))])).\ndomain_to_type(_, d_builtin(Builtin)) = builtin_type(Builtin).\ndomain_to_type(Var, d_type(TypeId, Args)) =\n type_ref(TypeId, map(domain_to_type(Var), Args)).\ndomain_to_type(Var, d_func(Inputs, Outputs, MaybeResources)) = Type :-\n ( MaybeResources = unknown_resources,\n % The resource-checking pass will fix this.\n Used = set.init,\n Observed = set.init\n ; MaybeResources = resources(Used, Observed)\n ),\n Type = func_type(map(domain_to_type(Var), Inputs),\n map(domain_to_type(Var), Outputs), Used, Observed).\ndomain_to_type(_, d_univ_var(TypeVar)) = type_variable(TypeVar).\n\n%-----------------------------------------------------------------------%\n\n:- type domain\n ---> d_free\n ; d_builtin(builtin_type)\n ; d_type(type_id, list(domain))\n ; d_func(list(domain), list(domain), maybe_resources)\n % A type variable from the function's signature.\n ; d_univ_var(type_var).\n\n:- func get_domain(map(svar, domain), svar) = domain.\n\nget_domain(Map, Var) =\n ( if map.search(Map, Var, Domain) then\n Domain\n else\n d_free\n ).\n\n:- type groundness\n ---> bound_with_holes_or_free\n % Type information is ground but resource information always has\n % unknown groundness.\n ; ground_maybe_resources\n ; ground.\n\n:- func groundness(domain) = groundness.\n\ngroundness(d_free) = bound_with_holes_or_free.\ngroundness(d_builtin(_)) = ground.\ngroundness(d_type(_, Args)) = Groundness :-\n ( if\n some [Arg] (\n member(Arg, Args),\n ArgGroundness = groundness(Arg),\n ArgGroundness = bound_with_holes_or_free\n )\n then\n Groundness = bound_with_holes_or_free\n else\n Groundness = ground\n ).\ngroundness(d_func(Inputs, Outputs, _)) = Groundness :-\n ( if\n some [Arg] (\n ( member(Arg, Inputs) ; member(Arg, Outputs) ),\n ArgGroundness = groundness(Arg),\n ArgGroundness = bound_with_holes_or_free\n )\n then\n Groundness = bound_with_holes_or_free\n else\n Groundness = ground_maybe_resources\n ).\ngroundness(d_univ_var(_)) = ground.\n\n%-----------------------------------------------------------------------%\n\n:- type unify_result(D)\n ---> unified(D, domain_status)\n ; failed(why_failed).\n\n:- type domain_status\n % new_domain can include delays\n ---> new_domain\n ; old_domain\n ; delayed.\n\n:- type unify_result == unify_result(domain).\n\n:- func unify_domains(domain, domain) = unify_result.\n\nunify_domains(Dom1, Dom2) = Dom :-\n ( Dom1 = d_free,\n ( Dom2 = d_free,\n Dom = unified(d_free, delayed)\n ;\n ( Dom2 = d_builtin(_)\n ; Dom2 = d_type(_, _)\n ; Dom2 = d_func(_, _, _)\n ; Dom2 = d_univ_var(_)\n ),\n Dom = unified(Dom2, new_domain)\n )\n ; Dom1 = d_builtin(Builtin1),\n ( Dom2 = d_free,\n Dom = unified(Dom1, new_domain)\n ; Dom2 = d_builtin(Builtin2),\n ( if Builtin1 = Builtin2 then\n Dom = unified(Dom1, old_domain)\n else\n Dom = failed(mismatch(Dom1, Dom2, no))\n )\n ;\n ( Dom2 = d_type(_, _)\n ; Dom2 = d_func(_, _, _)\n ; Dom2 = d_univ_var(_)\n ),\n Dom = failed(mismatch(Dom1, Dom2, no))\n )\n ; Dom1 = d_type(Type1, Args1),\n ( Dom2 = d_free,\n Dom = unified(Dom1, new_domain)\n ; Dom2 = d_type(Type2, Args2),\n ( if\n Type1 = Type2,\n length(Args1, ArgsLen),\n length(Args2, ArgsLen)\n then\n MaybeNewArgs = unify_args_domains(Args1, Args2),\n ( MaybeNewArgs = unified(Args, ArgsUpdated),\n ( ArgsUpdated = new_domain,\n Dom = unified(d_type(Type1, Args), new_domain)\n ; ArgsUpdated = old_domain,\n Dom = unified(d_type(Type1, Args1), old_domain)\n ; ArgsUpdated = delayed,\n Dom = unified(d_type(Type1, Args), delayed)\n )\n ; MaybeNewArgs = failed(Why),\n Dom = failed(mismatch(Dom1, Dom2, yes(Why)))\n )\n else\n Dom = failed(mismatch(Dom1, Dom2, no))\n )\n ;\n ( Dom2 = d_builtin(_)\n ; Dom2 = d_func(_, _, _)\n ; Dom2 = d_univ_var(_)\n ),\n Dom = failed(mismatch(Dom1, Dom2, no))\n )\n ; Dom1 = d_func(Inputs1, Outputs1, MaybeRes1),\n ( Dom2 = d_free,\n Dom = unified(Dom1, new_domain)\n ; Dom2 = d_func(Inputs2, Outputs2, MaybeRes2),\n ( if\n length(Inputs1, InputsLen),\n length(Inputs2, InputsLen),\n length(Outputs1, OutputsLen),\n length(Outputs2, OutputsLen)\n then\n MaybeNewInputs = unify_args_domains(Inputs1, Inputs2),\n MaybeNewOutputs = unify_args_domains(Outputs1, Outputs2),\n ( MaybeNewInputs = failed(Why),\n Dom = failed(mismatch(Dom1, Dom2, yes(Why)))\n ; MaybeNewInputs = unified(Inputs, InputsUpdated),\n ( MaybeNewOutputs = failed(Why),\n Dom = failed(mismatch(Dom1, Dom2, yes(Why)))\n ; MaybeNewOutputs = unified(Outputs, OutputsUpdated),\n unify_resources(MaybeRes1, MaybeRes2, MaybeRes,\n ResUpdated),\n NewDom = d_func(Inputs, Outputs, MaybeRes),\n Dom = unified(NewDom, greatest_domain_status(\n greatest_domain_status(InputsUpdated,\n OutputsUpdated),\n ResUpdated))\n )\n )\n else\n Dom = failed(mismatch(Dom1, Dom2, no))\n )\n ;\n ( Dom2 = d_builtin(_)\n ; Dom2 = d_type(_, _)\n ; Dom2 = d_univ_var(_)\n ),\n Dom = failed(mismatch(Dom1, Dom2, no))\n )\n ; Dom1 = d_univ_var(Var1),\n ( Dom2 = d_free,\n Dom = unified(Dom1, new_domain)\n ; Dom2 = d_univ_var(Var2),\n ( if Var1 = Var2 then\n Dom = unified(Dom1, old_domain)\n else\n Dom = failed(mismatch(Dom1, Dom2, no))\n )\n ;\n ( Dom2 = d_builtin(_)\n ; Dom2 = d_type(_, _)\n ; Dom2 = d_func(_, _, _)\n ),\n Dom = failed(mismatch(Dom1, Dom2, no))\n )\n ).\n\n:- func unify_args_domains(list(domain), list(domain)) =\n unify_result(list(domain)).\n\nunify_args_domains(Args1, Args2) = Doms :-\n MaybeNewArgs = map_corresponding(unify_domains, Args1, Args2),\n RevDoms = foldl(unify_args_domains_2, MaybeNewArgs,\n unified([], old_domain)),\n ( RevDoms = unified(Rev, Updated),\n Doms0 = reverse(Rev),\n Doms = unified(Doms0, Updated)\n ; RevDoms = failed(Why),\n Doms = failed(Why)\n ).\n\n:- func unify_args_domains_2(unify_result,\n unify_result(list(domain))) = unify_result(list(domain)).\n\nunify_args_domains_2(A, !.R) = !:R :-\n ( !.R = failed(_)\n ; !.R = unified(RD, Updated0),\n ( A = failed(Why),\n !:R = failed(Why)\n ; A = unified(AD, UpdatedA),\n !:R = unified([AD | RD], greatest_domain_status(Updated0, UpdatedA))\n )\n ).\n\n:- func greatest_domain_status(domain_status, domain_status) = domain_status.\n\ngreatest_domain_status(A, B) =\n ( if A = new_domain ; B = new_domain then\n new_domain\n else if A = delayed ; B = delayed then\n delayed\n else if A = old_domain , B = old_domain then\n old_domain\n else\n unexpected($file, $pred, \"Case not covered\")\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred unify_resources(maybe_resources::in, maybe_resources::in,\n maybe_resources::out, domain_status::out) is det.\n\nunify_resources(unknown_resources, unknown_resources, unknown_resources,\n delayed).\nunify_resources(unknown_resources, resources(Us, Os), resources(Us, Os),\n new_domain).\nunify_resources(resources(Us, Os), unknown_resources, resources(Us, Os),\n new_domain).\nunify_resources(resources(UsA, OsA), resources(UsB, OsB), resources(Us, Os),\n Status) :-\n Us = union(UsA, UsB),\n Os = union(OsA, OsB),\n % Technically we could subtract the used items from the observed. but\n % that may make this computation non-monotonic and I think we need that\n % for the type solver to terminate.\n\n ( if equal(UsA, UsB), equal(OsA, OsB) then\n Status = delayed\n else\n Status = new_domain\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type type_vars == int.\n\n:- type type_var_map(T)\n ---> type_var_map(\n tvm_source :: int,\n tvm_map :: map(T, int)\n ).\n\ninit_type_vars = 0.\n\nstart_type_var_mapping(Source, type_var_map(Source, init)).\n\nend_type_var_mapping(type_var_map(Source, _), Source).\n\nget_or_make_type_var(Name, Var, !Map) :-\n ( if search(!.Map ^ tvm_map, Name, Id) then\n Var = v_type_var(Id)\n else\n make_type_var(Name, Var, !Map)\n ).\n\nmake_type_var(Name, Var, !Map) :-\n Id = !.Map ^ tvm_source,\n det_insert(Name, Id, !.Map ^ tvm_map, NewMap),\n Var = v_type_var(Id),\n !:Map = type_var_map(Id + 1, NewMap).\n\nlookup_type_var(Map, Name) = v_type_var(map.lookup(Map ^ tvm_map, Name)).\n\nmaybe_add_free_type_var(Context, Name,\n cl_var_free_type_var(Var, Name, Context), !Map) :-\n get_or_make_type_var(Name, Var, !Map).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.types.m", "content": "%-----------------------------------------------------------------------%\n% Plasma types representation\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module core.types.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module context.\n\n%-----------------------------------------------------------------------%\n\n:- type type_\n ---> builtin_type(builtin_type)\n ; func_type(\n % Arg types\n list(type_),\n % Return types\n list(type_),\n % Uses\n set(resource_id),\n % Observes\n set(resource_id)\n )\n ; type_variable(type_var)\n ; type_ref(type_id, list(type_)).\n\n:- type type_var == string.\n\n % XXX: Should probably handle type var renaming/remapping.\n %\n:- pred types_equal_except_resources(type_::in, type_::in) is semidet.\n\n:- type builtin_type\n ---> int\n ; codepoint\n ; string\n ; string_pos.\n\n:- pred builtin_type_name(builtin_type, nq_name).\n:- mode builtin_type_name(in, out) is det.\n:- mode builtin_type_name(out, in) is semidet.\n\n % All types have constructors, but some types don't have constructor\n % IDs (Strings, Ints, etc) and some don't provide them (abstract types).\n %\n:- func type_get_ctors(core, type_) = maybe(list(ctor_id)).\n\n % Return all the resources that appear in this type.\n %\n:- func type_get_resources(type_) = set(resource_id).\n\n:- func type_get_types(type_) = set(type_id).\n\n%-----------------------------------------------------------------------%\n\n:- type user_type.\n\n:- func type_init(q_name, list(string), list(ctor_id), sharing_opaque,\n imported, context) = user_type.\n\n:- func type_init_abstract(q_name, arity, context) = user_type.\n\n:- func utype_get_name(user_type) = q_name.\n\n:- func utype_get_params(user_type) = maybe(list(string)).\n\n:- func utype_get_ctors(user_type) = maybe(list(ctor_id)).\n\n:- func utype_get_sharing(user_type) = sharing_opaque.\n\n:- func utype_get_imported(user_type) = imported.\n\n:- func utype_get_arity(user_type) = arity.\n\n:- func utype_get_context(user_type) = context.\n\n:- func utype_get_resources(core, user_type) = set(resource_id).\n\n:- func utype_get_types(core, user_type) = set(type_id).\n\n%-----------------------------------------------------------------------%\n\n:- type constructor\n ---> constructor(\n c_name :: q_name,\n c_params :: list(type_var),\n c_fields :: list(type_field)\n ).\n\n:- type type_field\n ---> type_field(\n tf_name :: q_name,\n tf_type :: type_\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n%-----------------------------------------------------------------------%\n\ntypes_equal_except_resources(T1, T2) :-\n require_complete_switch [T1]\n ( T1 = builtin_type(B),\n T2 = builtin_type(B)\n ; T1 = type_variable(V),\n T2 = type_variable(V)\n ; T1 = type_ref(TypeId, ArgsA),\n T2 = type_ref(TypeId, ArgsB),\n all_true_corresponding(types_equal_except_resources, ArgsA, ArgsB)\n ; T1 = func_type(ArgsA, OutA, _, _),\n T2 = func_type(ArgsB, OutB, _, _),\n all_true_corresponding(types_equal_except_resources, ArgsA, ArgsB),\n all_true_corresponding(types_equal_except_resources, OutA, OutB)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pragma promise_equivalent_clauses(builtin_type_name/2).\n\nbuiltin_type_name(Type::in, nq_name_det(String)::out) :-\n builtin_type_name_2(Type, String).\nbuiltin_type_name(Type::out, Name::in) :-\n builtin_type_name_2(Type, nq_name_to_string(Name)).\n\n:- pred builtin_type_name_2(builtin_type, string).\n:- mode builtin_type_name_2(in, out) is det.\n:- mode builtin_type_name_2(out, in) is semidet.\n\nbuiltin_type_name_2(int, \"Int\").\nbuiltin_type_name_2(codepoint, \"CodePoint\").\nbuiltin_type_name_2(string, \"String\").\nbuiltin_type_name_2(string_pos, \"StringPos\").\n\n%-----------------------------------------------------------------------%\n\ntype_get_ctors(_, builtin_type(_)) = no.\ntype_get_ctors(_, func_type(_, _, _, _)) = no.\ntype_get_ctors(_, type_variable(_)) = no.\ntype_get_ctors(Core, type_ref(TypeId, _)) =\n utype_get_ctors(core_get_type(Core, TypeId)).\n\n%-----------------------------------------------------------------------%\n\ntype_get_resources(builtin_type(_)) = set.init.\ntype_get_resources(func_type(_, _, Uses, Observes)) = Uses `set.union`\n Observes.\ntype_get_resources(type_variable(_)) = set.init.\ntype_get_resources(type_ref(_, Args)) = set.union_list(\n map(type_get_resources, Args)).\n\n%-----------------------------------------------------------------------%\n\n:- type user_type\n ---> user_type(\n t_symbol :: q_name,\n t_params :: list(string),\n t_ctors :: list(ctor_id),\n t_sharing :: sharing_opaque,\n t_imported :: imported,\n t_context :: context\n )\n ; abstract_type(\n at_symbol :: q_name,\n at_arity :: arity,\n at_context :: context\n ).\n\ntype_init(Name, Params, Ctors, Sharing, Imported, Context) =\n user_type(Name, Params, Ctors, Sharing, Imported, Context).\n\ntype_init_abstract(Name, Arity, Context) = abstract_type(Name, Arity, Context).\n\nutype_get_name(user_type(S, _, _, _, _, _)) = S.\nutype_get_name(abstract_type(S, _, _)) = S.\n\nutype_get_params(user_type(_, Params, _, _, _, _)) = yes(Params).\nutype_get_params(abstract_type(_, _, _)) = no.\n\nutype_get_ctors(Type) =\n ( if Ctors = Type ^ t_ctors then\n yes(Ctors)\n else\n no\n ).\n\nutype_get_sharing(user_type(_, _, _, Sharing, _, _)) = Sharing.\nutype_get_sharing(abstract_type(_, _, _)) = so_private.\n\nutype_get_imported(user_type(_, _, _, _, Imported, _)) = Imported.\nutype_get_imported(abstract_type(_, _, _)) = i_imported.\n\nutype_get_arity(user_type(_, Params, _, _, _, _)) = arity(length(Params)).\nutype_get_arity(abstract_type(_, Arity, _)) = Arity.\n\nutype_get_context(user_type(_, _, _, _, _, Context)) = Context.\nutype_get_context(abstract_type(_, _, Context)) = Context.\n\n%-----------------------------------------------------------------------%\n\nutype_get_resources(Core, user_type(_, _, Ctors, _, _, _)) =\n union_list(map(ctor_get_resources(Core), Ctors)).\nutype_get_resources(_, abstract_type(_, _, _)) = set.init.\n\n:- func ctor_get_resources(core, ctor_id) = set(resource_id).\n\nctor_get_resources(Core, CtorId) = Res :-\n core_get_constructor_det(Core, CtorId, Ctor),\n Ctor = constructor(_, _, Fields),\n Res = union_list(map(field_get_resources, Fields)).\n\n:- func field_get_resources(type_field) = set(resource_id).\n\nfield_get_resources(type_field(_, Type)) =\n type_get_resources(Type).\n\n%-----------------------------------------------------------------------%\n\nutype_get_types(Core, user_type(_, _, Ctors, _, _, _)) =\n union_list(map(ctor_get_types(Core), Ctors)).\nutype_get_types(_, abstract_type(_, _, _)) = set.init.\n\n:- func ctor_get_types(core, ctor_id) = set(type_id).\n\nctor_get_types(Core, CtorId) = Types :-\n core_get_constructor_det(Core, CtorId, Ctor),\n Ctor = constructor(_, _, Fields),\n Types = union_list(map(field_get_types, Fields)).\n\n:- func field_get_types(type_field) = set(type_id).\n\nfield_get_types(type_field(_, TypeExpr)) =\n type_get_types(TypeExpr).\n\ntype_get_types(builtin_type(_)) = set.init.\ntype_get_types(func_type(Params, Returns, _, _)) =\n union_list(map(type_get_types, Params)) `union`\n union_list(map(type_get_types, Returns)).\ntype_get_types(type_variable(_)) = set.init.\ntype_get_types(type_ref(TypeId, Args)) =\n set.make_singleton_set(TypeId) `union`\n union_list(map(type_get_types, Args)).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core.util.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core.util.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT see ../LICENSE.code\n%\n% Utility code for the core stage.\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module io.\n\n:- import_module compile_error.\n:- import_module util.log.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n % Process all non-imported functions that havn't generated errors in\n % prior passes.\n %\n:- pred process_noerror_funcs(log_config,\n pred(core, func_id, function, result_partial(function, compile_error)),\n errors(compile_error), core, core, io, io).\n:- mode process_noerror_funcs(in,\n pred(in, in, in, out) is det,\n out, in, out, di, uo) is det.\n\n:- pred process_noerror_scc_funcs(log_config,\n pred(core, func_id, function, result_partial(function, compile_error)),\n errors(compile_error), core, core, io, io).\n:- mode process_noerror_scc_funcs(in,\n pred(in, in, in, out) is det,\n out, in, out, di, uo) is det.\n\n:- pred check_noerror_funcs(log_config,\n func(core, func_id, function) = errors(compile_error),\n errors(compile_error), core, core, io, io).\n:- mode check_noerror_funcs(in,\n func(in, in, in) = (out) is det,\n out, in, out, di, uo) is det.\n\n%-----------------------------------------------------------------------%\n\n:- pred create_anon_var_with_type(type_::in, var::out,\n varmap::in, varmap::out, map(var, type_)::in, map(var, type_)::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\nprocess_noerror_funcs(Verbose, Pred, Errors, !Core, !IO) :-\n Funcs = core_all_defined_functions(!.Core),\n map_foldl2(process_func(Verbose, Pred), Funcs, ErrorsList, !Core, !IO),\n Errors = cord_list_to_cord(ErrorsList).\n\n:- pred process_func(log_config,\n pred(core, func_id, function, result_partial(function, compile_error)),\n pair(func_id, function), errors(compile_error), core, core, io, io).\n:- mode process_func(in,\n pred(in, in, in, out) is det,\n in, out, in, out, di, uo) is det.\n\nprocess_func(Verbose, Pred, FuncId - Func0, Errors, !Core, !IO) :-\n ( if not func_has_error(Func0) then\n FuncName = func_get_name(Func0),\n verbose_output(Verbose,\n format(\" processing %s\\n\", [s(q_name_to_string(FuncName))]),\n !IO),\n Pred(!.Core, FuncId, Func0, Result),\n ( Result = ok(Func, Errors)\n ; Result = errors(Errors),\n func_raise_error(Func0, Func)\n ),\n core_set_function(FuncId, Func, !Core)\n else\n Errors = init\n ).\n\n%-----------------------------------------------------------------------%\n\nprocess_noerror_scc_funcs(Verbose, Pred, Errors, !Core, !IO) :-\n SCCs = core_all_defined_functions_sccs(!.Core),\n FuncIds = map(make_func_pair(!.Core),\n condense(map(to_sorted_list, reverse(SCCs)))),\n map_foldl2(process_func(Verbose, Pred), FuncIds, ErrorsList, !Core, !IO),\n Errors = cord_list_to_cord(ErrorsList).\n\n:- func make_func_pair(core, func_id) = pair(func_id, function).\n\nmake_func_pair(Core, FuncId) = FuncId - Func :-\n core_get_function_det(Core, FuncId, Func).\n\n%-----------------------------------------------------------------------%\n\ncheck_noerror_funcs(Verbose, Func, Errors, !Core, !IO) :-\n process_noerror_funcs(Verbose,\n (pred(C::in, Id::in, F::in, R::out) is det :-\n ErrorsI = Func(C, Id, F),\n ( if has_fatal_errors(ErrorsI) then\n R = errors(ErrorsI)\n else\n R = ok(F, ErrorsI)\n )\n ), Errors, !Core, !IO).\n\n%-----------------------------------------------------------------------%\n\ncreate_anon_var_with_type(Type, Var, !Varmap, !Vartypes) :-\n add_anon_var(Var, !Varmap),\n det_insert(Var, Type, !Vartypes).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core_to_pz.closure.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core_to_pz.closure.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Structures and code to help construct closures.\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n%-----------------------------------------------------------------------%\n\n:- type closure_builder.\n\n:- func closure_builder_init(pzs_id) = closure_builder.\n\n:- pred closure_add_field(pz_data_value::in, field_num::out,\n closure_builder::in, closure_builder::out) is det.\n\n % Create the environment for the closure.\n %\n:- pred closure_finalize_data(closure_builder::in, pzd_id::out,\n pz::in, pz::out) is det.\n\n:- func closure_get_struct(closure_builder) = pzs_id.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module int.\n\n%-----------------------------------------------------------------------%\n\n:- type closure_builder\n ---> closure_builder(\n cb_struct :: pzs_id,\n cb_rev_values :: list(pz_data_value),\n cb_next_field_num :: int\n ).\n\nclosure_builder_init(Struct) = closure_builder(Struct, [], 1).\n\n%-----------------------------------------------------------------------%\n\nclosure_add_field(DataValue, field_num(FieldNum),\n closure_builder(Struct, DataValues, FieldNum),\n closure_builder(Struct, [DataValue | DataValues], FieldNum + 1)).\n\n%-----------------------------------------------------------------------%\n\nclosure_finalize_data(CB, DataId, !PZ) :-\n Values = reverse(CB ^ cb_rev_values),\n Types = duplicate(length(Values), pzw_ptr),\n pz_add_struct(CB ^ cb_struct, pz_struct(Types), !PZ),\n pz_new_data_id(DataId, !PZ),\n pz_add_data(DataId, pz_data(type_struct(CB ^ cb_struct), Values), !PZ).\n\n%-----------------------------------------------------------------------%\n\nclosure_get_struct(CB) = CB ^ cb_struct.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core_to_pz.code.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core_to_pz.code.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Plasma core to pz conversion - code generation.\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module builtins.\n:- import_module core.\n:- import_module core_to_pz.locn.\n:- import_module pz.\n\n%-----------------------------------------------------------------------%\n\n:- pred gen_func(compile_options::in, core::in, val_locn_map_static::in,\n pz_builtin_ids::in, map(string, pzd_id)::in,\n type_tag_map::in, constructor_data_map::in,\n pzs_id::in, pair(func_id, function)::in, pz::in, pz::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module assoc_list.\n:- import_module char.\n:- import_module cord.\n:- import_module int.\n:- import_module int32.\n:- import_module pair.\n:- import_module maybe.\n:- import_module string.\n:- import_module set.\n:- import_module uint8.\n:- import_module uint32.\n\n:- import_module context.\n:- import_module core.code.\n:- import_module core.pretty.\n:- import_module core_to_pz.closure.\n:- import_module util.\n:- import_module util.my_exception.\n:- import_module util.mercury.\n\n%-----------------------------------------------------------------------%\n\ngen_func(CompileOpts, Core, LocnMap, BuiltinProcs, FilenameDataMap,\n TypeTagInfo, TypeCtorTagInfo, ModEnvStructId, FuncId - Func, !PZ) :-\n Symbol = func_get_name(Func),\n\n func_get_type_signature(Func, Input0, Output0, _),\n Input = map(type_to_pz_width, Input0),\n Output = map(type_to_pz_width, Output0),\n Signature = pz_signature(Input, Output),\n\n ( if\n func_get_body(Func, Varmap, Inputs, Captured, BodyExpr),\n func_get_vartypes(Func, Vartypes)\n then\n % This can eventually be replaced by something smarter that\n % actually re-orders code as a compiler phase, for now this is\n % good enough to get some reasonble codegen.\n find_oneuse_vars(BodyExpr, set.init, _ZeroUse, set.init, OneUse),\n\n some [!LocnMap] (\n !:LocnMap = LocnMap,\n StructMap = pz_get_struct_names_map(!.PZ),\n ( Captured = [],\n IsClosure = not_closure\n ; Captured = [_ | _],\n IsClosure = is_closure\n ),\n CGInfo = code_gen_info(CompileOpts, Core, BuiltinProcs,\n TypeTagInfo, TypeCtorTagInfo, FuncId, Vartypes, Varmap,\n IsClosure, OneUse, ModEnvStructId, StructMap,\n FilenameDataMap),\n vl_start_var_binding(!LocnMap),\n ( IsClosure = not_closure\n ; IsClosure = is_closure,\n EnvStructId = vl_lookup_closure(!.LocnMap, FuncId),\n vl_setup_closure(EnvStructId, field_num_first, !LocnMap),\n foldl2(set_captured_var_locn(CGInfo, EnvStructId), Captured,\n !LocnMap, field_num_next(field_num_first), _)\n ),\n gen_proc_body(CGInfo, !.LocnMap, Inputs, BodyExpr, Blocks)\n ),\n ProcId = vls_lookup_proc_id(LocnMap, FuncId),\n Proc = pz_proc(Symbol, Signature, yes(Blocks)),\n pz_add_proc(ProcId, Proc, !PZ)\n else\n unexpected($file, $pred, \"Function missing body or types\")\n ).\n\n:- pred gen_proc_body(code_gen_info::in, val_locn_map::in, list(var)::in,\n expr::in, list(pz_block)::out) is det.\n\ngen_proc_body(CGInfo, !.LocnMap, Params, Expr, Blocks) :-\n Varmap = CGInfo ^ cgi_varmap,\n some [!Blocks] (\n !:Blocks = pz_blocks(0u32, map.init),\n alloc_block(EntryBlockId, !Blocks),\n\n initial_bind_map(Params, 0, Varmap, ParamDepthComments, !LocnMap),\n\n Depth = length(Params),\n gen_instrs(CGInfo, Expr, Depth, !.LocnMap, cont_return, ExprInstrs,\n !Blocks),\n\n % Finish block.\n create_block(EntryBlockId, ParamDepthComments ++ ExprInstrs, !Blocks),\n Blocks = values(to_sorted_assoc_list(!.Blocks ^ pzb_blocks))\n ).\n\n:- pred set_captured_var_locn(code_gen_info::in, pzs_id::in, var::in,\n val_locn_map::in, val_locn_map::out, field_num::in, field_num::out) is det.\n\nset_captured_var_locn(CGInfo, EnvStructId, Var, !Map, !FieldNum) :-\n lookup(CGInfo ^ cgi_type_map, Var, Type),\n Width = type_to_pz_width(Type),\n vl_set_var_env(Var, EnvStructId, !.FieldNum, Width, !Map),\n !:FieldNum = field_num_next(!.FieldNum).\n\n%-----------------------------------------------------------------------%\n\n % fixup_stack(BottomItems, Items)\n %\n % Fixup the stack, This is used to remove some BottomItems from benieth\n % Items on the stack, so that the stack is at the correct depth and has\n % only Items on it. For example fixup_stack(2, 3) will take a stack\n % like:\n %\n % b1 b2 i1 i2 i3\n %\n % And remove b1 and b2 creating:\n %\n % i1 i2 i3\n %\n:- func fixup_stack(int, int) = cord(pz_instr_obj).\n\nfixup_stack(BottomItems, Items) = Fixup :-\n ( if BottomItems < 0 ; Items < 0 then\n unexpected($file, $pred,\n format(\"fixup_stack(%d, %d)\", [i(BottomItems), i(Items)]))\n else\n Fixup0 = fixup_stack_2(BottomItems, Items),\n ( if is_empty(Fixup0) then\n Fixup = singleton(pzio_comment(\"no fixup\"))\n else\n Fixup = cons(pzio_comment(\n format(\"fixup_stack(%d, %d)\", [i(BottomItems), i(Items)])),\n map((func(I) = pzio_instr(I)), Fixup0))\n )\n ).\n\n:- func fixup_stack_2(int, int) = cord(pz_instr).\n\nfixup_stack_2(BottomItems, Items) =\n ( if BottomItems = 0 then\n % There are no items underneath the items we want to return.\n init\n else if Items = 0 then\n % There are no items on the top, so we can just drop BottomItems.\n cord.from_list(condense(duplicate(BottomItems, [pzi_drop])))\n else\n cord.from_list([pzi_roll(BottomItems + Items), pzi_drop]) ++\n fixup_stack_2(BottomItems - 1, Items)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type code_gen_info\n ---> code_gen_info(\n cgi_options :: compile_options,\n cgi_core :: core,\n cgi_builtin_ids :: pz_builtin_ids,\n cgi_type_tags :: map(type_id, type_tag_info),\n cgi_type_ctor_tags :: map({type_id, ctor_id},\n constructor_data),\n cgi_this_func :: func_id,\n cgi_type_map :: map(var, type_),\n cgi_varmap :: varmap,\n cgi_func_is_closure :: is_closure,\n cgi_var_one_use :: set(var),\n cgi_mod_env_struct :: pzs_id,\n cgi_struct_names :: map(pzs_id, string),\n cgi_filename_data :: map(string, pzd_id)\n ).\n\n:- type is_closure\n % The function runs in some environment other than the module's\n % environment.\n ---> is_closure\n % The function runs in the module's environment.\n ; not_closure.\n\n % gen_instrs(Info, Expr, Depth, LocnMap, Cont, Instrs, !Blocks).\n %\n % Generate instructions (Instrs) for an expression (Expr) and it's\n % continuation (Cont). The continuation is important for handling\n % returns, switches and lets. It represents what to execute after this\n % expression.\n %\n:- pred gen_instrs(code_gen_info::in, expr::in, int::in, val_locn_map::in,\n continuation::in, cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out)\n is det.\n\ngen_instrs(CGInfo, Expr, Depth, LocnMap, Continuation, CtxtInstrs ++ Instrs,\n !Blocks) :-\n Expr = expr(ExprType, CodeInfo),\n\n Context = code_info_context(CodeInfo),\n ( if not is_nil_context(Context) then\n FilenameDataId = lookup(CGInfo ^ cgi_filename_data, Context ^ c_file),\n PZContext = pz_context(Context, FilenameDataId)\n else\n PZContext = pz_nil_context\n ),\n CtxtInstrs = singleton(pzio_context(PZContext)),\n\n ( ExprType = e_call(Callee, Args, _),\n gen_call(CGInfo, Callee, Args, CodeInfo, Depth, LocnMap,\n Continuation, Instrs)\n ;\n ( ExprType = e_var(Var),\n InstrsMain = gen_var_access(CGInfo, LocnMap, Var, Depth)\n ; ExprType = e_constant(Const),\n ( Const = c_number(Num),\n InstrsMain = singleton(pzio_instr(\n pzi_load_immediate(pzw_fast, im_i32(det_from_int(Num)))))\n ; Const = c_string(String),\n ( if\n [builtin_type(string)] = code_info_types(CodeInfo)\n then\n Locn = vl_lookup_str(LocnMap, String),\n InstrsMain = gen_val_locn_access(CGInfo, Depth, LocnMap,\n Locn)\n else if\n [builtin_type(codepoint)] = code_info_types(CodeInfo)\n then\n % We can use det_from_int because Unicode won't exceed\n % range.\n InstrsMain = singleton(pzio_instr(pzi_load_immediate(pzw_32,\n im_u32(det_from_int(to_int(det_index(String, 0)))))))\n else\n unexpected($file, $pred,\n \"String literal has invalid type\")\n )\n ; Const = c_func(FuncId),\n Locn = vl_lookup_proc(LocnMap, FuncId),\n ( Locn = pl_static_proc(PID),\n % Make a closure. TODO: To support closures in\n % Plasma we'll need to move this into a earlier\n % stage of the compiler.\n InstrsMain = from_list([\n pzio_instr(pzi_get_env),\n pzio_instr(pzi_make_closure(PID))\n ])\n ; Locn = pl_other(ValLocn),\n InstrsMain = gen_val_locn_access(CGInfo, Depth, LocnMap,\n ValLocn)\n ; Locn = pl_instrs(_, no),\n % This should have been filtered out and wrapped in a\n % proc if it appears as a constant.\n unexpected($file, $pred, \"Instructions\")\n ; Locn = pl_instrs(_, yes(PID)),\n InstrsMain = from_list([\n pzio_instr(pzi_get_env),\n pzio_instr(pzi_make_closure(PID))\n ])\n )\n ; Const = c_ctor(_),\n my_exception.sorry($file, $pred, Context,\n \"Type constructor as higher order value\")\n )\n ; ExprType = e_construction(CtorIds, Args),\n CtorId = one_item_in_set(CtorIds),\n TypeId = one_item(code_info_types(CodeInfo)),\n gen_instrs_args(CGInfo, LocnMap, Args, ArgsInstrs, Depth, _),\n InstrsMain = ArgsInstrs ++\n gen_construction(CGInfo, TypeId, CtorId)\n ; ExprType = e_closure(FuncId, Captured),\n gen_closure(CGInfo, FuncId, Captured, Depth, LocnMap, InstrsMain)\n ),\n Arity = code_info_arity_det(CodeInfo),\n InstrsCont = gen_continuation(Continuation, Depth, Arity ^ a_num,\n \"gen_instrs\"),\n Instrs = InstrsMain ++ InstrsCont\n ; ExprType = e_tuple(Exprs),\n gen_tuple(CGInfo, Exprs, Depth, LocnMap, Continuation,\n Instrs, !Blocks)\n ; ExprType = e_lets(Lets, InExpr),\n gen_lets(CGInfo, Lets, InExpr, Depth, LocnMap, Continuation,\n Instrs, !Blocks)\n ; ExprType = e_match(Var, Cases),\n gen_match(CGInfo, Var, Cases, Depth, LocnMap,\n Continuation, Instrs, !Blocks)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred gen_call(code_gen_info::in, callee::in, list(var)::in, code_info::in,\n int::in, val_locn_map::in, continuation::in, cord(pz_instr_obj)::out)\n is det.\n\ngen_call(CGInfo, Callee, Args, CodeInfo, Depth, LocnMap, Continuation,\n Instrs) :-\n Core = CGInfo ^ cgi_core,\n Varmap = CGInfo ^ cgi_varmap,\n gen_instrs_args(CGInfo, LocnMap, Args, InstrsArgs, Depth, _),\n\n ( Callee = c_plain(FuncId),\n core_get_function_det(Core, FuncId, Func),\n Decl = func_call_pretty(Core, Func, Varmap, Args),\n CallComment = singleton(pzio_comment(Decl)),\n\n Locn = vl_lookup_proc(LocnMap, FuncId),\n ( Locn = pl_instrs(Instrs0, _),\n % The function is implemented with a short sequence of\n % instructions.\n Instrs1 = singleton(pzio_comment(\"Callee is instructions\")) ++\n cord.from_list(map((func(I) = pzio_instr(I)), Instrs0)),\n PrepareStackInstrs = init\n ; Locn = pl_static_proc(PID),\n ( if\n is_closure = CGInfo ^ cgi_func_is_closure,\n FuncId \\= CGInfo ^ cgi_this_func\n then\n % We're in a closure, but this plain call needs the\n % environment of the module, so we need a closue call.\n % TODO This causes a memory allocation that could be eleuded\n % if we added an instruction to execute a predicate with a\n % given environment (from the stack) as a closure call. But\n % rather than add that now first we should Fix Bug #333.\n LookupInstrs = gen_val_locn_access(CGInfo, Depth, LocnMap,\n vl_lookup_mod_env(LocnMap)),\n InstrsClosure = LookupInstrs ++ singleton(\n pzio_instr(pzi_make_closure(PID))),\n MbPZCallee = no\n else\n InstrsClosure = init,\n MbPZCallee = yes(pzc_proc_opt(PID))\n ),\n\n ( if\n can_tailcall(CGInfo, c_plain(FuncId), Continuation)\n then\n % Note that we fixup the stack before making a tailcall\n % because the continuation isn't used.\n PrepareStackInstrs = fixup_stack(Depth, length(Args)),\n ( MbPZCallee = yes(PZCallee),\n Instr = pzi_tcall(PZCallee)\n ; MbPZCallee = no,\n Instr = pzi_tcall_ind\n )\n else\n PrepareStackInstrs = init,\n ( MbPZCallee = yes(PZCallee),\n Instr = pzi_call(PZCallee)\n ; MbPZCallee = no,\n Instr = pzi_call_ind\n )\n ),\n Instrs1 = InstrsClosure ++ singleton(pzio_instr(Instr))\n ; Locn = pl_other(ValLocn),\n PrepareStackInstrs = init,\n Instrs1 =\n singleton(pzio_comment(\n \"Accessing callee as value location\")) ++\n gen_val_locn_access(CGInfo, Depth, LocnMap, ValLocn) ++\n singleton(pzio_instr(pzi_call_ind))\n )\n ; Callee = c_ho(HOVar),\n HOVarName = varmap.get_var_name(Varmap, HOVar),\n map.lookup(CGInfo ^ cgi_type_map, HOVar, HOType),\n ( if\n HOType = func_type(HOTypeArgs, HOTypeReturns, HOUses,\n HOObserves)\n then\n Pretty = type_pretty_func(Core, HOVarName, HOTypeArgs,\n HOTypeReturns, HOUses, HOObserves)\n else\n unexpected($file, $pred,\n \"Called variable is not a function type\")\n ),\n CallComment = singleton(pzio_comment(Pretty)),\n HOVarDepth = Depth + length(Args),\n Instrs1 = gen_var_access(CGInfo, LocnMap, HOVar, HOVarDepth) ++\n singleton(pzio_instr(pzi_call_ind)),\n PrepareStackInstrs = init\n ),\n InstrsMain = CallComment ++ InstrsArgs ++ PrepareStackInstrs ++ Instrs1,\n Arity = code_info_arity_det(CodeInfo),\n ( if can_tailcall(CGInfo, Callee, Continuation) then\n % We did a tail call so there's no continuation.\n InstrsCont = empty\n else\n InstrsCont = gen_continuation(Continuation, Depth, Arity ^ a_num,\n \"gen_instrs\")\n ),\n Instrs = InstrsMain ++ InstrsCont.\n\n:- pred can_tailcall(code_gen_info::in, callee::in, continuation::in)\n is semidet.\n\ncan_tailcall(CGInfo, Callee, Continuation) :-\n EnableTailcalls = CGInfo ^ cgi_options ^ co_enable_tailcalls,\n EnableTailcalls = enable_tailcalls,\n Core = CGInfo ^ cgi_core,\n Continuation = cont_return,\n Callee = c_plain(FuncId),\n core_get_function_det(Core, FuncId, Func),\n Imported = func_get_imported(Func),\n % XXX: This particular definition of importedness might not be\n % suitable if it diverges from where the actual code is.\n Imported = i_local.\n\n%-----------------------------------------------------------------------%\n\n:- pred gen_tuple(code_gen_info::in, list(expr)::in,\n int::in, val_locn_map::in, continuation::in, cord(pz_instr_obj)::out,\n pz_blocks::in, pz_blocks::out) is det.\n\ngen_tuple(_, [], Depth, _, Continuation, Instrs, !Blocks) :-\n Instrs = gen_continuation(Continuation, Depth, 0, \"Empty tuple\").\ngen_tuple(CGInfo, [Arg], Depth, LocnMap, Continue, Instrs, !Blocks) :-\n gen_instrs(CGInfo, Arg, Depth, LocnMap, Continue, Instrs, !Blocks).\ngen_tuple(CGInfo, Args@[_, _ | _], Depth, LocnMap, Continue, Instrs,\n !Blocks) :-\n % LocnMap does not change in a list of arguments because arguments\n % do not affect one-another's environment.\n\n ( if all [Arg] member(Arg, Args) =>\n Arity = code_info_arity_det(Arg ^ e_info),\n Arity ^ a_num = 1\n then\n gen_tuple_loop(CGInfo, Args, Depth, LocnMap, init, InstrsArgs,\n !Blocks),\n TupleLength = length(Args),\n InstrsContinue = gen_continuation(Continue, Depth, TupleLength,\n \"Tuple\"),\n\n Instrs = InstrsArgs ++ InstrsContinue\n else\n unexpected($file, $pred, \"Bad expression arity used in argument\")\n ).\n\n:- pred gen_tuple_loop(code_gen_info::in, list(expr)::in,\n int::in, val_locn_map::in, cord(pz_instr_obj)::in, cord(pz_instr_obj)::out,\n pz_blocks::in, pz_blocks::out) is det.\n\ngen_tuple_loop(_, [], _, _, !Instrs, !Blocks).\ngen_tuple_loop(CGInfo, [Expr | Exprs], Depth, LocnMap, !Instrs,\n !Blocks) :-\n gen_instrs(CGInfo, Expr, Depth, LocnMap, cont_none(Depth), ExprInstrs,\n !Blocks),\n !:Instrs = !.Instrs ++ ExprInstrs,\n gen_tuple_loop(CGInfo, Exprs, Depth+1, LocnMap, !Instrs,\n !Blocks).\n\n%-----------------------------------------------------------------------%\n\n:- pred gen_lets(code_gen_info::in, list(expr_let)::in, expr::in,\n int::in, val_locn_map::in, continuation::in, cord(pz_instr_obj)::out,\n pz_blocks::in, pz_blocks::out) is det.\n\ngen_lets(CGInfo, Lets, InExpr, Depth, LocnMap, Continuation, Instrs,\n !Blocks) :-\n ( Lets = [],\n gen_instrs(CGInfo, InExpr, Depth, LocnMap, Continuation, Instrs,\n !Blocks)\n ; Lets = [L | Ls],\n L = e_let(Vars, LetExpr),\n\n ( if\n Vars = [Var],\n member(Var, CGInfo ^ cgi_var_one_use),\n no_bang_marker = code_info_bang_marker(LetExpr ^ e_info),\n not expr_has_branch(LetExpr)\n then\n % We can skip generation of this variable and generate it\n % directly when it is needed.\n vl_set_var_expr(Var, LetExpr, LocnMap, NextLocnMap),\n gen_lets(CGInfo, Ls, InExpr, Depth, NextLocnMap, Continuation,\n Instrs, !Blocks)\n else\n % Generate the instructions for the \"In\" part (the continuation\n % of the \"Let\" part).\n % Update the LocnMap for the \"In\" part of the expression. This\n % records the stack slot that we expect to find each variable.\n Varmap = CGInfo ^ cgi_varmap,\n vl_put_vars(Vars, Depth, Varmap, CommentBinds, LocnMap, InLocnMap),\n\n % Run the \"In\" expression.\n LetArity = code_info_arity_det(LetExpr ^ e_info),\n InDepth = Depth + LetArity ^ a_num,\n gen_lets(CGInfo, Ls, InExpr, InDepth, InLocnMap, Continuation,\n InInstrs, !Blocks),\n InContinuation = cont_comment(\n format(\"In at depth %d\", [i(InDepth)]),\n cont_instrs(InDepth, CommentBinds ++ InInstrs)),\n\n % Generate the instructions for the \"let\" part, using the \"in\"\n % part as the continuation.\n gen_instrs(CGInfo, LetExpr, Depth, LocnMap, InContinuation,\n Instrs0, !Blocks),\n Instrs = cons(pzio_comment(format(\"Let at depth %d\", [i(Depth)])),\n Instrs0)\n )\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred gen_match(code_gen_info::in, var::in, list(expr_case)::in,\n int::in, val_locn_map::in, continuation::in, cord(pz_instr_obj)::out,\n pz_blocks::in, pz_blocks::out) is det.\n\ngen_match(CGInfo, Var, Cases, Depth, LocnMap,\n Continuation, Instrs, !Blocks) :-\n % We can assume that the cases are exhaustive, there's no need to\n % generate match-all code. A transformation on the core\n % representation will ensure this.\n\n % First, generate the bodies of each case.\n continuation_make_block(Continuation, BranchContinuation, !Blocks),\n list.foldl3(gen_case(CGInfo, Depth+1, LocnMap, BranchContinuation,\n VarType),\n Cases, 1, _, map.init, CaseInstrMap, !Blocks),\n\n % Determine the type of switch requred. These are:\n % Casecading.\n % Switch on primary tag (plus value or secondary tag)\n %\n % Later there may be more eg: to support efficient string matching. Or\n % add computed gotos.\n %\n % Nested matches, or multiple patterns per case will need to be added\n % later, what we do WRT switch type will need to be reconsidered.\n %\n lookup(CGInfo ^ cgi_type_map, Var, VarType),\n SwitchType = var_type_switch_type(CGInfo, VarType),\n\n % Generate the switch, using the bodies generated above.\n BeginComment = pzio_comment(format(\"Switch at depth %d\", [i(Depth)])),\n GetVarInstrs = gen_var_access(CGInfo, LocnMap, Var, Depth),\n ( SwitchType = enum,\n TestsInstrs = gen_test_and_jump_enum(CGInfo, CaseInstrMap,\n VarType, Depth, Cases, 1)\n ; SwitchType = tags(_TypeId, TagInfo),\n gen_test_and_jump_tags(CGInfo, CaseInstrMap, VarType, TagInfo,\n Cases, TestsInstrs, !Blocks)\n ),\n Instrs = cord.singleton(BeginComment) ++ GetVarInstrs ++ TestsInstrs.\n\n:- type switch_type\n ---> enum\n ; tags(type_id, map(ptag, type_ptag_info)).\n\n:- func var_type_switch_type(code_gen_info, type_) = switch_type.\n\nvar_type_switch_type(_, builtin_type(Builtin)) = SwitchType :-\n ( Builtin = int,\n % This is really stupid, but it'll do for now.\n SwitchType = enum\n ; ( Builtin = string\n ; Builtin = codepoint\n ),\n my_exception.sorry($file, $pred,\n \"Cannot switch on strings/codepoints\")\n ; Builtin = string_pos,\n unexpected($file, $pred, \"Cannot switch on string_pos\")\n ).\nvar_type_switch_type(_, type_variable(_)) =\n unexpected($file, $pred, \"Switch types must be concrete\").\nvar_type_switch_type(_, func_type(_, _, _, _)) =\n unexpected($file, $pred, \"Cannot switch on functions\").\nvar_type_switch_type(CGInfo, type_ref(TypeId, _)) = SwitchType :-\n map.lookup(CGInfo ^ cgi_type_tags, TypeId, TagInfo),\n ( TagInfo = tti_untagged,\n SwitchType = enum\n ; TagInfo = tti_tagged(PTagInfos),\n SwitchType = tags(TypeId, PTagInfos)\n ; TagInfo = tti_abstract,\n unexpected($file, $pred, \"Can't switch on abstract type\")\n ).\n\n % The body of each case is placed in a new block.\n %\n % + If the pattern matches then we jump to that block, that block itself\n % will execute the expression then execute the continuation.\n % + Otherwise fall-through and try the next case.\n %\n % No indexing, jump tables or other optimisations are\n % implemented.\n %\n:- pred gen_case(code_gen_info::in, int::in, val_locn_map::in,\n continuation::in, type_::in, expr_case::in, int::in, int::out,\n map(int, pzb_id)::in, map(int, pzb_id)::out,\n pz_blocks::in, pz_blocks::out) is det.\n\ngen_case(CGInfo, !.Depth, LocnMap0, Continue, VarType,\n e_case(Pattern, Expr), !CaseNum, !InstrMap, !Blocks) :-\n alloc_block(BlockNum, !Blocks),\n det_insert(!.CaseNum, BlockNum, !InstrMap),\n !:CaseNum = !.CaseNum + 1,\n\n DepthCommentBeforeDecon = depth_comment_instr(!.Depth),\n % At the start of the new block we place code that will provide any\n % variables bound by the matching pattern.\n gen_deconstruction(CGInfo, Pattern, VarType, LocnMap0, LocnMap, !Depth,\n InstrsDecon),\n % Generate the body of the new block.\n gen_instrs(CGInfo, Expr, !.Depth, LocnMap, Continue, InstrsBranchBody,\n !Blocks),\n InstrsBranch = singleton(DepthCommentBeforeDecon) ++ InstrsDecon ++\n InstrsBranchBody,\n\n create_block(BlockNum, InstrsBranch, !Blocks).\n\n:- func gen_test_and_jump_enum(code_gen_info, map(int, pzb_id), type_,\n int, list(expr_case), int) = cord(pz_instr_obj).\n\ngen_test_and_jump_enum(_, _, _, _, [], _) = cord.init.\ngen_test_and_jump_enum(CGInfo, BlockMap, Type, Depth, [Case | Cases], CaseNum)\n = InstrsCase ++ InstrsCases :-\n e_case(Pattern, _) = Case,\n lookup(BlockMap, CaseNum, BlockNum),\n InstrsCase = gen_case_match_enum(CGInfo, Pattern, Type, BlockNum,\n Depth),\n InstrsCases = gen_test_and_jump_enum(CGInfo, BlockMap, Type, Depth,\n Cases, CaseNum + 1).\n\n % The variable that we're switching on is on the top of the stack, and\n % we can use it directly. But we need to put it back when we're done.\n %\n:- func gen_case_match_enum(code_gen_info, expr_pattern, type_,\n pzb_id, int) = cord(pz_instr_obj).\n\ngen_case_match_enum(_, p_num(Num), _, BlockNum, Depth) =\n cord.from_list([\n pzio_comment(format(\"Case for %d\", [i(Num)])),\n % Save the switched-on value for the next case.\n pzio_instr(pzi_pick(1)),\n % Compare Num with TOS and jump if equal.\n % TODO: need to actually check the type and use the correct\n % immediate, this works for now because all numbers are 'fast'.\n pzio_instr(pzi_load_immediate(pzw_fast, im_i32(det_from_int(Num)))),\n pzio_instr(pzi_eq(pzw_fast)),\n depth_comment_instr(Depth + 1),\n pzio_instr(pzi_cjmp(BlockNum, pzw_fast))]).\ngen_case_match_enum(_, p_variable(_), _, BlockNum, Depth) =\n cord.from_list([\n pzio_comment(\"Case match all and bind variable\"),\n depth_comment_instr(Depth),\n pzio_instr(pzi_jmp(BlockNum))]).\ngen_case_match_enum(_, p_wildcard, _, BlockNum, Depth) =\n cord.from_list([\n pzio_comment(\"Case match wildcard\"),\n depth_comment_instr(Depth),\n pzio_instr(pzi_jmp(BlockNum))]).\ngen_case_match_enum(CGInfo, p_ctor(CtorIds, _), VarType, BlockNum,\n Depth) = SetupInstrs ++ MatchInstrs ++ JmpInstrs :-\n CtorId = one_item_in_set(CtorIds),\n SetupInstrs = from_list([\n pzio_comment(\"Case match deconstruction\"),\n depth_comment_instr(Depth),\n % Save the switched-on value for the next case.\n pzio_instr(pzi_pick(1))]),\n ( VarType = type_ref(TypeId, _),\n MatchInstrs = gen_match_ctor(CGInfo, TypeId, VarType, CtorId)\n ;\n ( VarType = builtin_type(_)\n ; VarType = type_variable(_)\n ; VarType = func_type(_, _, _, _)\n ),\n unexpected($file, $pred,\n \"Deconstructions must be on user types\")\n ),\n JmpInstrs = from_list([\n depth_comment_instr(Depth + 1),\n pzio_instr(pzi_cjmp(BlockNum, pzw_fast))]).\n\n:- pred gen_test_and_jump_tags(code_gen_info::in, map(int, pzb_id)::in,\n type_::in, map(ptag, type_ptag_info)::in, list(expr_case)::in,\n cord(pz_instr_obj)::out, pz_blocks::in, pz_blocks::out) is det.\n\ngen_test_and_jump_tags(CGInfo, BlockMap, Type, PTagInfos, Cases, Instrs,\n !Blocks) :-\n % Get the ptag onto the TOS.\n BreakTagId = CGInfo ^ cgi_builtin_ids ^ pbi_break_tag,\n GetPtagInstrs = cord.from_list([\n pzio_comment(\"Break the tag, leaving the ptag on the TOS\"),\n pzio_instr(pzi_pick(1)),\n pzio_instr(pzi_call(pzc_import(BreakTagId)))]),\n\n % For every primary tag, test it, and jump to the case it maps to,\n % if there is none, jump to the default cease.\n foldl2(gen_test_and_jump_ptag(CGInfo, BlockMap, Cases, Type),\n PTagInfos, GetPtagInstrs, Instrs, !Blocks).\n\n:- pred gen_test_and_jump_ptag(code_gen_info::in, map(int, pzb_id)::in,\n list(expr_case)::in, type_::in, ptag::in, type_ptag_info::in,\n cord(pz_instr_obj)::in, cord(pz_instr_obj)::out,\n pz_blocks::in, pz_blocks::out) is det.\n\ngen_test_and_jump_ptag(CGInfo, BlockMap, Cases, Type, PTag, PTagInfo, !Instrs,\n !Blocks) :-\n Width = type_to_pz_width(Type),\n require(unify(Width, pzw_ptr), \"Expected pointer width\"),\n alloc_block(Next, !Blocks),\n Instrs = from_list([\n pzio_instr(pzi_pick(1)),\n pzio_instr(pzi_load_immediate(pzw_ptr,\n im_u32(cast_from_int(to_int(PTag))))),\n pzio_instr(pzi_eq(pzw_ptr)),\n pzio_instr(pzi_cjmp(Next, pzw_fast))\n ]),\n ( PTagInfo = tpti_constant(EnumMap),\n UnshiftValueId =\n CGInfo ^ cgi_builtin_ids ^ pbi_unshift_value,\n GetFieldInstrs = from_list([\n pzio_comment(\"Drop the primary tag,\"),\n pzio_instr(pzi_drop),\n pzio_comment(\"Unshift the tagged value.\"),\n pzio_instr(pzi_call(pzc_import(UnshiftValueId)))]),\n map_foldl(gen_test_and_jump_ptag_const(BlockMap, Cases),\n to_assoc_list(EnumMap), NextInstrsList, !Blocks),\n NextInstrs = GetFieldInstrs ++ cord_list_to_cord(NextInstrsList),\n create_block(Next, NextInstrs, !Blocks)\n ; PTagInfo = tpti_pointer(CtorId),\n % Drop the the saved copy of the tag and value off the stack.\n % Depending on the code we jump to there we may need to recreate the\n % value. We could optimise this _a lot_ better.\n DropInstrs = from_list([\n pzio_comment(\"Drop the tag and value then jump\"),\n pzio_instr(pzi_drop),\n pzio_instr(pzi_drop),\n pzio_instr(pzi_jmp(Dest))]),\n create_block(Next, DropInstrs, !Blocks),\n\n find_matching_case(Cases, 1, CtorId, _MatchParams, _Expr, CaseNum),\n lookup(BlockMap, CaseNum, Dest)\n ; PTagInfo = tpti_pointer_stag(STagMap),\n STagStruct = CGInfo ^ cgi_builtin_ids ^ pbi_stag_struct,\n GetStagInstrs = from_list([\n pzio_comment(\"Drop the primary tag\"),\n pzio_instr(pzi_drop),\n pzio_comment(\"The pointer is on TOS, get the stag from it\"),\n pzio_instr(pzi_load(STagStruct, field_num(1), pzw_fast)),\n pzio_instr(pzi_drop)\n ]),\n map_foldl(gen_test_and_jump_ptag_stag(BlockMap, Cases),\n to_assoc_list(STagMap), SwitchStagInstrs, !Blocks),\n NextInstrs = GetStagInstrs ++ cord_list_to_cord(SwitchStagInstrs),\n create_block(Next, NextInstrs, !Blocks)\n ),\n !:Instrs = !.Instrs ++ Instrs.\n\n:- pred gen_test_and_jump_ptag_const(map(int, pzb_id)::in, list(expr_case)::in,\n pair(word_bits, ctor_id)::in, cord(pz_instr_obj)::out,\n pz_blocks::in, pz_blocks::out) is det.\n\ngen_test_and_jump_ptag_const(BlockMap, Cases, ConstVal - CtorId, Instrs,\n !Blocks) :-\n alloc_block(Drop, !Blocks),\n\n Instrs = from_list([\n pzio_instr(pzi_pick(1)),\n pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(ConstVal))),\n pzio_instr(pzi_eq(pzw_ptr)),\n pzio_instr(pzi_cjmp(Drop, pzw_fast))\n ]),\n\n find_matching_case(Cases, 1, CtorId, _MatchParams, _Expr, CaseNum),\n lookup(BlockMap, CaseNum, Dest),\n DropInstrs = from_list([\n pzio_comment(\"Drop the secondary tag then jump\"),\n pzio_instr(pzi_drop),\n pzio_instr(pzi_jmp(Dest))]),\n create_block(Drop, DropInstrs, !Blocks).\n\n:- pred gen_test_and_jump_ptag_stag(map(int, pzb_id)::in, list(expr_case)::in,\n pair(stag, ctor_id)::in, cord(pz_instr_obj)::out,\n pz_blocks::in, pz_blocks::out) is det.\n\ngen_test_and_jump_ptag_stag(BlockMap, Cases, STag - CtorId, Instrs,\n !Blocks) :-\n alloc_block(Drop, !Blocks),\n\n Instrs = from_list([\n pzio_instr(pzi_pick(1)),\n pzio_instr(pzi_load_immediate(pzw_fast, im_u32(STag))),\n pzio_instr(pzi_eq(pzw_fast)),\n pzio_instr(pzi_cjmp(Drop, pzw_fast))\n ]),\n\n find_matching_case(Cases, 1, CtorId, _MatchParams, _Expr, CaseNum),\n lookup(BlockMap, CaseNum, Dest),\n DropInstrs = from_list([\n pzio_comment(\"Drop the value then jump\"),\n pzio_instr(pzi_drop),\n pzio_instr(pzi_jmp(Dest))]),\n create_block(Drop, DropInstrs, !Blocks).\n\n:- pred find_matching_case(list(expr_case)::in, int::in, ctor_id::in,\n list(var)::out, expr::out, int::out) is det.\n\nfind_matching_case([], _, _, _, _, _) :-\n unexpected($file, $pred, \"Case not found\").\nfind_matching_case([Case | Cases], ThisCaseNum, CtorId, Vars, Expr, CaseNum) :-\n Case = e_case(Pattern, Expr0),\n ( Pattern = p_num(_),\n unexpected($file, $pred,\n \"Type error: A number can't match a constructor\")\n ; Pattern = p_variable(_),\n my_exception.sorry($file, $pred, \"How to set vars\"),\n Vars = [],\n Expr = Expr0,\n CaseNum = ThisCaseNum\n ; Pattern = p_wildcard,\n Vars = [],\n Expr = Expr0,\n CaseNum = ThisCaseNum\n ; Pattern = p_ctor(ThisCtorIds, ThisVars),\n ThisCtorId = one_item_in_set(ThisCtorIds),\n ( if CtorId = ThisCtorId then\n Vars = ThisVars,\n Expr = Expr0,\n CaseNum = ThisCaseNum\n else\n find_matching_case(Cases, ThisCaseNum + 1, CtorId, Vars, Expr,\n CaseNum)\n )\n ).\n\n % Generate code that attempts to match a data constructor. It has the\n % stack usage (ptr - w) the input is a copy of the value to switch on,\n % the output is a boolean suitable for \"cjmp\".\n %\n % TODO: This could be made a call to a pz procedure. Making it a call\n % (outline) matches the pz style, letting the interpreter do the\n % inlining. It may also make separate compilation simpler.\n %\n:- func gen_match_ctor(code_gen_info, type_id, type_, ctor_id) =\n cord(pz_instr_obj).\n\ngen_match_ctor(CGInfo, TypeId, Type, CtorId) = Instrs :-\n map.lookup(CGInfo ^ cgi_type_ctor_tags, {TypeId, CtorId}, CtorData),\n TagInfo = CtorData ^ cd_tag_info,\n Width = type_to_pz_width(Type),\n ( TagInfo = ti_constant(PTag, WordBits),\n require(unify(Width, pzw_ptr), \"Width must be pointer for constant\"),\n ShiftMakeTagId = CGInfo ^ cgi_builtin_ids ^ pbi_shift_make_tag,\n Instrs = from_list([\n % Compare tagged value with TOS and jump if equal.\n pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(WordBits))),\n pzio_instr(pzi_load_immediate(pzw_ptr,\n im_u32(cast_from_int(to_int(PTag))))),\n pzio_instr(pzi_call(pzc_import(ShiftMakeTagId))),\n pzio_instr(pzi_eq(pzw_ptr))])\n ; TagInfo = ti_constant_notag(Word),\n Instrs = from_list([\n % Compare constant value with TOS and jump if equal.\n pzio_instr(pzi_load_immediate(Width, im_u32(Word))),\n pzio_instr(pzi_eq(Width))])\n ; TagInfo = ti_tagged_pointer(PTag, _, MaybeSTag),\n require(unify(Width, pzw_ptr),\n \"Width must be pointer for tagged pointer\"),\n % TODO: This is currently unused.\n ( MaybeSTag = no,\n BreakTagId = CGInfo ^ cgi_builtin_ids ^ pbi_break_tag,\n % TODO rather than dropping the pointer we should save it and use it\n % for deconstruction later.\n Instrs = from_list([\n pzio_instr(pzi_call(pzc_import(BreakTagId))),\n pzio_instr(pzi_roll(2)),\n pzio_instr(pzi_drop),\n pzio_instr(pzi_load_immediate(pzw_ptr,\n im_u32(cast_from_int(to_int(PTag))))),\n pzio_instr(pzi_eq(pzw_ptr))])\n ; MaybeSTag = yes(_),\n my_exception.sorry($file, $pred, \"Secondary tags\")\n )\n ).\n\n:- pred gen_deconstruction(code_gen_info::in, expr_pattern::in, type_::in,\n val_locn_map::in, val_locn_map::out, int::in, int::out,\n cord(pz_instr_obj)::out) is det.\n\ngen_deconstruction(_, p_num(_), _, !LocnMap, !Depth, Instrs) :-\n % Drop the switched on variable when entering the branch.\n Instrs = singleton(pzio_instr(pzi_drop)),\n !:Depth = !.Depth - 1.\ngen_deconstruction(_, p_wildcard, _, !LocnMap, !Depth, Instrs) :-\n % Drop the switched on variable when entering the branch.\n Instrs = singleton(pzio_instr(pzi_drop)),\n !:Depth = !.Depth - 1.\ngen_deconstruction(CGInfo, p_variable(Var), _, !LocnMap, !Depth,\n Instrs) :-\n Varmap = CGInfo ^ cgi_varmap,\n % Leave the value on the stack and update the bind map so that the\n % expression can find it.\n % NOTE: This call expects the depth where the variable begins.\n vl_put_vars([Var], !.Depth - 1, Varmap, Instrs, !LocnMap).\ngen_deconstruction(CGInfo, p_ctor(CtorIds, Args), VarType, !LocnMap, !Depth,\n Instrs) :-\n (\n VarType = type_ref(TypeId, _),\n CtorId = one_item_in_set(CtorIds),\n map.lookup(CGInfo ^ cgi_type_ctor_tags, {TypeId, CtorId}, CtorData),\n TagInfo = CtorData ^ cd_tag_info,\n (\n ( TagInfo = ti_constant(_, _)\n ; TagInfo = ti_constant_notag(_)\n ),\n % Discard the value, it doesn't bind any variables.\n Instrs = singleton(pzio_instr(pzi_drop)),\n !:Depth = !.Depth - 1\n ; TagInfo = ti_tagged_pointer(_, StructId, MaybeSTag),\n ( MaybeSTag = no,\n FirstField = field_num(1)\n ; MaybeSTag = yes(_),\n FirstField = field_num(2)\n ),\n\n % Untag the pointer, TODO: skip this if it's known that the tag\n % is zero.\n BreakTag = CGInfo ^ cgi_builtin_ids ^ pbi_break_tag,\n InstrsUntag = cord.from_list([\n pzio_comment(\"Untag pointer and deconstruct\"),\n pzio_instr(pzi_call(pzc_import(BreakTag))),\n pzio_instr(pzi_drop)]),\n\n % TODO: Optimisation, only read the variables that are used in\n % the body. Further optimisation could leave some on the heap,\n % avoiding stack usage.\n core_get_constructor_det(CGInfo ^ cgi_core, CtorId, Ctor),\n Varmap = CGInfo ^ cgi_varmap,\n gen_decon_fields(Varmap, StructId, Args, Ctor ^ c_fields,\n FirstField, InstrsDeconstruct, !LocnMap, !Depth),\n InstrDrop = pzio_instr(pzi_drop),\n Instrs = InstrsUntag ++ InstrsDeconstruct ++ singleton(InstrDrop),\n !:Depth = !.Depth - 1\n )\n ;\n ( VarType = builtin_type(_)\n ; VarType = type_variable(_)\n ; VarType = func_type(_, _, _, _)\n ),\n unexpected($file, $pred,\n \"Deconstructions must be on user types\")\n ).\n\n:- pred gen_decon_fields(varmap::in, pzs_id::in,\n list(var)::in, list(type_field)::in, field_num::in, cord(pz_instr_obj)::out,\n val_locn_map::in, val_locn_map::out, int::in, int::out) is det.\n\ngen_decon_fields(_, _, [], [], _,\n init, !LocnMap, !Depth).\ngen_decon_fields(_, _, [], [_ | _], _,\n _, !LocnMap, !Depth) :-\n unexpected($file, $pred, \"Mismatched arg/field lists\").\ngen_decon_fields(_, _, [_ | _], [], _,\n _, !LocnMap, !Depth) :-\n unexpected($file, $pred, \"Mismatched arg/field lists\").\ngen_decon_fields(Varmap, StructId, [Arg | Args], [Field | Fields], FieldNo,\n InstrsField ++ InstrsFields, !LocnMap, !Depth) :-\n gen_decon_field(Varmap, StructId, Arg, Field, FieldNo,\n InstrsField, !LocnMap, !Depth),\n gen_decon_fields(Varmap, StructId, Args, Fields, field_num_next(FieldNo),\n InstrsFields, !LocnMap, !Depth).\n\n:- pred gen_decon_field(varmap::in, pzs_id::in, var::in, type_field::in,\n field_num::in, cord(pz_instr_obj)::out,\n val_locn_map::in, val_locn_map::out, int::in, int::out) is det.\n\ngen_decon_field(Varmap, StructId, Var, _Field, FieldNo, Instrs, !LocnMap,\n !Depth) :-\n Instrs = cord.from_list([\n pzio_comment(format(\"reading field %d\", [i(FieldNo ^ field_num_int)])),\n pzio_instr(pzi_load(StructId, FieldNo, pzw_ptr)),\n pzio_comment(format(\"%s is at depth %d\",\n [s(get_var_name(Varmap, Var)), i(!.Depth)]))\n ]),\n\n % Update the LocnMap\n vl_put_var(Var, !.Depth, !LocnMap),\n\n % Load is (ptr - * ptr) so we increment the depth here.\n !:Depth = !.Depth + 1.\n\n%-----------------------------------------------------------------------%\n\n:- func gen_construction(code_gen_info, type_, ctor_id) =\n cord(pz_instr_obj).\n\ngen_construction(CGInfo, Type, CtorId) = Instrs :-\n ( Type = builtin_type(_),\n unexpected($file, $pred, \"No builtin types are constructed with\n e_construction\")\n ; Type = type_variable(_),\n unexpected($file, $pred, \"Polymorphic values are never constructed\")\n ; Type = type_ref(TypeId, _),\n map.lookup(CGInfo ^ cgi_type_ctor_tags, {TypeId, CtorId}, CtorData),\n CtorProc = CtorData ^ cd_construct_proc,\n\n Instrs = from_list([\n pzio_comment(\"Call constructor\"),\n pzio_instr(pzi_call(pzc_proc_opt(CtorProc)))])\n ; Type = func_type(_, _, _, _),\n my_exception.sorry($file, $pred, \"Function type\")\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred gen_closure(code_gen_info::in, func_id::in, list(var)::in,\n int::in, val_locn_map::in, cord(pz_instr_obj)::out) is det.\n\ngen_closure(CGInfo, FuncId, Captured, !.Depth, LocnMap, Instrs) :-\n StructId = vl_lookup_closure(LocnMap, FuncId),\n AllocEnvInstrs = from_list([\n pzio_comment(\"Constructing closure\"),\n pzio_instr(pzi_alloc(StructId))\n ]),\n !:Depth = !.Depth + 1,\n\n ModEnvLocn = vl_lookup_mod_env(LocnMap),\n SetModuleEnvFieldInstrs =\n gen_val_locn_access(CGInfo, !.Depth, LocnMap, ModEnvLocn) ++\n from_list([pzio_instr(pzi_swap),\n pzio_instr(pzi_store(StructId, field_num_first, pzw_ptr))]),\n\n map_foldl(\n (pred(V::in, Is::out, FldN::in, field_num_next(FldN)::out) is det :-\n map.lookup(CGInfo ^ cgi_type_map, V, Type),\n Width = type_to_pz_width(Type),\n Is = gen_var_access(CGInfo, LocnMap, V, !.Depth) ++\n from_list([\n pzio_instr(pzi_swap),\n pzio_instr(pzi_store(StructId, FldN, Width))\n ])\n ), Captured, SetFieldsInstrs0, field_num_next(field_num_first), _),\n SetFieldsInstrs = cord_list_to_cord(SetFieldsInstrs0),\n\n ProcId = vl_lookup_proc_id(LocnMap, FuncId),\n MakeClosureInstrs = singleton(pzio_instr(pzi_make_closure(ProcId))),\n\n Instrs = AllocEnvInstrs ++ SetModuleEnvFieldInstrs ++ SetFieldsInstrs ++\n MakeClosureInstrs.\n\n%-----------------------------------------------------------------------%\n\n:- type continuation\n ---> cont_return\n ; cont_jump(cj_depth :: int, cj_block :: pzb_id)\n ; cont_instrs(int, cord(pz_instr_obj))\n ; cont_comment(string, continuation)\n ; cont_none(int).\n\n % gen_continuation(Continuation, Depth, NumItems, Why) = ContInstrs\n %\n % Generate the code for the continuation. The continuation may need to\n % adjust the stack which is currently Depth + NumItems. NumItems is the\n % number of items that the continuation will want to process. Why is a\n % label to help debug code generation, it shows why we're making this\n % continuation (ie the caller).\n %\n % TODO: Why doesn't the continuation itself know about NumItems?\n %\n:- func gen_continuation(continuation, int, int, string) = cord(pz_instr_obj).\n\ngen_continuation(Cont, Depth, Items, Why) =\n cons(pzio_comment(format(\n \"Continuation at depth %d with %d items from %s\",\n [i(Depth), i(Items), s(Why)])),\n gen_continuation_2(Cont, Depth, Items)).\n\n:- func gen_continuation_2(continuation, int, int) = cord(pz_instr_obj).\n\ngen_continuation_2(cont_return, Depth, Items) =\n snoc(fixup_stack(Depth, Items), pzio_instr(pzi_ret)).\ngen_continuation_2(cont_jump(WantDepth, Block), CurDepth, Items) =\n snoc(FixupStack, pzio_instr(pzi_jmp(Block))) :-\n % Fixup the stack to put it at Depth plus Items.\n % Wanted depth includes the items on the stack, so we add them here.\n BottomItems = CurDepth + Items - WantDepth,\n FixupStack = fixup_stack(BottomItems, Items).\ngen_continuation_2(cont_instrs(WantDepth, Instrs), CurDepth, Items) =\n FixupStack ++ CommentInstrs ++ Instrs :-\n % Fixup the stack to put it at Depth plus Items.\n % Wanted depth includes the items on the stack, so we add them here.\n BottomItems = CurDepth + Items - WantDepth,\n FixupStack = fixup_stack(BottomItems, Items),\n CommentInstrs = singleton(pzio_comment(\n format(\"Continuation depth is %d\", [i(WantDepth)]))).\ngen_continuation_2(cont_comment(Comment, Continuation), CurDepth, Items) =\n cons(pzio_comment(Comment),\n gen_continuation_2(Continuation, CurDepth, Items)).\ngen_continuation_2(cont_none(WantDepth), CurDepth, Items) =\n singleton(pzio_comment(\"No continuation\")) ++\n fixup_stack(CurDepth - WantDepth, Items).\n\n:- pred continuation_make_block(continuation::in, continuation::out,\n pz_blocks::in, pz_blocks::out) is det.\n\ncontinuation_make_block(cont_return, cont_return, !Blocks).\ncontinuation_make_block(cont_jump(Depth, Block), cont_jump(Depth, Block),\n !Blocks).\ncontinuation_make_block(cont_instrs(Depth, Instrs), cont_jump(Depth, BlockId),\n !Blocks) :-\n alloc_block(BlockId, !Blocks),\n create_block(BlockId, Instrs, !Blocks).\ncontinuation_make_block(cont_comment(Comment, Cont0),\n cont_comment(Comment, Cont), !Blocks) :-\n continuation_make_block(Cont0, Cont, !Blocks).\ncontinuation_make_block(cont_none(Depth), cont_none(Depth), !Blocks).\n\n%-----------------------------------------------------------------------%\n\n:- func depth_comment_instr(int) = pz_instr_obj.\n\ndepth_comment_instr(Depth) = pzio_comment(format(\"Depth: %d\", [i(Depth)])).\n\n:- func gen_var_access(code_gen_info, val_locn_map, var, int) =\n cord(pz_instr_obj).\n\ngen_var_access(CGInfo, LocnMap, Var, Depth) = Instrs :-\n VarName = get_var_name(CGInfo ^ cgi_varmap, Var),\n CommentInstr = pzio_comment(format(\"get var %s\", [s(VarName)])),\n ( if vl_search_var(LocnMap, Var, VarLocn) then\n Instrs = singleton(CommentInstr) ++\n gen_val_locn_access(CGInfo, Depth, LocnMap, VarLocn)\n else\n core_get_function_det(CGInfo ^ cgi_core, CGInfo ^ cgi_this_func,\n Func),\n FuncName = func_get_name(Func),\n unexpected($file, $pred,\n format(\"The code generator could not find the location of \" ++\n \"a variable '%s' when compiling '%s'. \" ++\n \"This is most-likely a bug in an earlier pass\",\n [s(VarName), s(q_name_to_string(FuncName))]))\n ).\n\n:- pred gen_instrs_args(code_gen_info::in, val_locn_map::in,\n list(var)::in, cord(pz_instr_obj)::out, int::in, int::out) is det.\n\ngen_instrs_args(CGInfo, LocnMap, Args, InstrsArgs, !Depth) :-\n map_foldl((pred(V::in, I::out, D0::in, D::out) is det :-\n I = gen_var_access(CGInfo, LocnMap, V, D0),\n D = D0 + 1\n ), Args, InstrsArgs0, !Depth),\n InstrsArgs = cord_list_to_cord(InstrsArgs0).\n\n%-----------------------------------------------------------------------%\n\n:- func gen_val_locn_access(code_gen_info, int, val_locn_map, val_locn) =\n cord(pz_instr_obj).\n\ngen_val_locn_access(CGInfo, Depth, _, vl_stack(VarDepth, Next)) =\n Instrs ++ gen_val_locn_access_next(CGInfo, Next) :-\n RelDepth = Depth - VarDepth + 1,\n Instrs = from_list([\n pzio_comment(\"value is on the stack\"),\n pzio_instr(pzi_pick(RelDepth))]).\ngen_val_locn_access(CGInfo, _, _, vl_env(Next)) =\n from_list([\n pzio_comment(\"value is available from the environment\"),\n pzio_instr(pzi_get_env)]) ++\n gen_val_locn_access_next(CGInfo, Next).\ngen_val_locn_access(CGInfo, Depth, LocnMap, vl_compute(Expr)) = Instrs :-\n % + Don't generate blocks (test that Expr has no case)\n % + Don't require continuation.\n gen_instrs(CGInfo, Expr, Depth, LocnMap, cont_none(Depth), Instrs,\n pz_blocks(0u32, map.init), pz_blocks(LastBlockNo, _)),\n ( if LastBlockNo \\= 0u32 then\n unexpected($file, $pred, \"Cannot create blocks here\")\n else\n true\n ).\n\n:- func gen_val_locn_access_next(code_gen_info, val_locn_next) =\n cord(pz_instr_obj).\n\ngen_val_locn_access_next(_, vln_done) = init.\ngen_val_locn_access_next(CGInfo, vln_struct(StructId, Field, Width, Next)) =\n Instrs ++ gen_val_locn_access_next(CGInfo, Next) :-\n StructName = lookup(CGInfo ^ cgi_struct_names, StructId),\n Instrs = from_list([\n pzio_comment(format(\"Lookup in %s\", [s(StructName)])),\n pzio_instr(pzi_load(StructId, Field, Width)),\n pzio_instr(pzi_drop)]).\n\n%-----------------------------------------------------------------------%\n\n:- type pz_blocks\n ---> pz_blocks(\n pzb_next_block :: pzb_id,\n pzb_blocks :: map(pzb_id, pz_block)\n ).\n\n:- pred alloc_block(pzb_id::out, pz_blocks::in, pz_blocks::out) is det.\n\nalloc_block(BlockId, !Blocks) :-\n BlockId = !.Blocks ^ pzb_next_block,\n !Blocks ^ pzb_next_block := BlockId + 1u32.\n\n:- pred create_block(pzb_id::in, cord(pz_instr_obj)::in,\n pz_blocks::in, pz_blocks::out) is det.\n\ncreate_block(BlockId, Instrs, !Blocks) :-\n Block = pz_block(cord.list(Instrs)),\n BlockMap0 = !.Blocks ^ pzb_blocks,\n det_insert(BlockId, Block, BlockMap0, BlockMap),\n !Blocks ^ pzb_blocks := BlockMap.\n\n%-----------------------------------------------------------------------%\n\n:- pred initial_bind_map(list(var)::in, int::in, varmap::in,\n cord(pz_instr_obj)::out, val_locn_map::in, val_locn_map::out)\n is det.\n\ninitial_bind_map(Vars, Depth, Varmap, Comments, !Map) :-\n vl_put_vars(Vars, Depth, Varmap, Comments, !Map).\n\n%-----------------------------------------------------------------------%\n\n % This algorithm walks the expression tree.\n %\n % When it encouters the introduction of a new variable via a let\n % expression (but not pattern matches) and the expression does not use\n % or observe a resource, it ads it to the !ZeroUses set.\n %\n % When it sees the use of a it:\n % + If the variable is in !SeenZero it moves it to !SeenOne.\n % + IF the variable is in !SeenOne it removes it.\n %\n % When it terminates the bindings in !SeenZero can be optimised away\n % completely, and those in !SeenOne can be moved into their only use\n % site.\n %\n:- pred find_oneuse_vars(expr::in, set(var)::in, set(var)::out,\n set(var)::in, set(var)::out) is det.\n\nfind_oneuse_vars(expr(Type, _), !ZeroUses, !OneUse) :-\n ( Type = e_tuple(Exprs),\n foldl2(find_oneuse_vars, Exprs, !ZeroUses, !OneUse)\n ; Type = e_lets(Lets, Expr),\n foldl2(find_oneuse_vars_let, Lets, !ZeroUses, !OneUse),\n find_oneuse_vars(Expr, !ZeroUses, !OneUse)\n ; Type = e_call(Callee, Args, _),\n ( Callee = c_plain(_)\n ; Callee = c_ho(Var),\n find_oneuse_vars_var(Var, !ZeroUses, !OneUse)\n ),\n foldl2(find_oneuse_vars_var, Args, !ZeroUses, !OneUse)\n ; Type = e_var(Var),\n find_oneuse_vars_var(Var, !ZeroUses, !OneUse)\n ; Type = e_constant(_)\n ; Type = e_construction(_, Args),\n foldl2(find_oneuse_vars_var, Args, !ZeroUses, !OneUse)\n ; Type = e_closure(_, Args),\n foldl2(find_oneuse_vars_var, Args, !ZeroUses, !OneUse)\n ; Type = e_match(Var, Cases),\n find_oneuse_vars_var(Var, !ZeroUses, !OneUse),\n foldl2(find_oneuse_vars_case, Cases, !ZeroUses, !OneUse)\n ).\n\n:- pred find_oneuse_vars_let(expr_let::in, set(var)::in, set(var)::out,\n set(var)::in, set(var)::out) is det.\n\nfind_oneuse_vars_let(e_let(Vars, Expr), !ZeroUses, !OneUse) :-\n find_oneuse_vars(Expr, !ZeroUses, !OneUse),\n union(list_to_set(Vars), !ZeroUses).\n\n:- pred find_oneuse_vars_case(expr_case::in, set(var)::in, set(var)::out,\n set(var)::in, set(var)::out) is det.\n\nfind_oneuse_vars_case(e_case(Pat, Expr), !ZeroUses, !OneUse) :-\n ( Pat = p_num(_)\n ; Pat = p_variable(Var),\n insert(Var, !ZeroUses)\n ; Pat = p_wildcard\n ; Pat = p_ctor(_, Vars),\n union(list_to_set(Vars), !ZeroUses)\n ),\n find_oneuse_vars(Expr, !ZeroUses, !OneUse).\n\n:- pred find_oneuse_vars_var(var::in, set(var)::in, set(var)::out,\n set(var)::in, set(var)::out) is det.\n\nfind_oneuse_vars_var(Var, !ZeroUse, !OneUse) :-\n ( if remove(Var, !OneUse) then\n true\n else if remove(Var, !ZeroUse) then\n insert(Var, !OneUse)\n else\n true\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core_to_pz.data.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core_to_pz.data.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Plasma core to pz conversion - data layout decisions\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module maybe.\n:- import_module string.\n\n:- import_module builtins.\n:- import_module common_types.\n:- import_module core.\n:- import_module core_to_pz.closure.\n:- import_module core_to_pz.locn.\n:- import_module pz.\n\n%-----------------------------------------------------------------------%\n\n:- type const_data\n ---> cd_string(string).\n\n:- pred gen_const_data(core::in,\n val_locn_map_static::in, val_locn_map_static::out,\n closure_builder::in, closure_builder::out,\n map(string, pzd_id)::in, map(string, pzd_id)::out, pz::in, pz::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- type constructor_data_map ==\n map({type_id, ctor_id}, constructor_data).\n\n % How to represent this constructor in memory.\n %\n:- type constructor_data\n ---> constructor_data(\n cd_tag_info :: ctor_tag_info,\n cd_construct_proc :: pzp_id\n ).\n\n:- type ctor_tag_info\n ---> ti_constant(\n tic_ptag :: ptag,\n tic_word_bits :: word_bits\n )\n ; ti_constant_notag(\n ticnw_bits :: word_bits\n )\n ; ti_tagged_pointer(\n titp_ptag :: ptag,\n titp_struct :: pzs_id,\n titp_maybe_stag :: maybe(stag)\n ).\n\n:- type ptag == uint8.\n:- type stag == uint32.\n:- type word_bits == uint32.\n\n:- type type_tag_map == map(type_id, type_tag_info).\n\n:- type type_tag_info\n % Pure enums are untagged.\n ---> tti_untagged\n ; tti_tagged(\n map(ptag, type_ptag_info)\n )\n ; tti_abstract.\n\n:- type type_ptag_info\n ---> tpti_constant(map(word_bits, ctor_id))\n ; tpti_pointer(ctor_id)\n ; tpti_pointer_stag(map(stag, ctor_id)).\n\n:- pred gen_constructor_data(core::in, pz_builtin_ids::in,\n type_tag_map::out, constructor_data_map::out,\n pz::in, pz::out) is det.\n\n:- func data_rep_pretty({core, type_tag_map, constructor_data_map}) =\n cord(string).\n\n%-----------------------------------------------------------------------%\n\n:- func num_ptag_bits = int.\n\n:- func type_to_pz_width(type_) = pz_width.\n\n:- func bool_width = pz_width.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module assoc_list.\n:- import_module char.\n:- import_module cord.\n:- import_module int.\n:- import_module uint32.\n:- import_module uint8.\n\n:- import_module context.\n:- import_module core.code.\n\n%-----------------------------------------------------------------------%\n\ngen_const_data(Core, !LocnMap, !ModuleClo, !FilenameDataMap, !PZ) :-\n foldl4(gen_const_data_func, core_all_functions(Core),\n !LocnMap, !ModuleClo, !FilenameDataMap, !PZ).\n\n:- pred gen_const_data_func(pair(func_id, function)::in,\n val_locn_map_static::in, val_locn_map_static::out,\n closure_builder::in, closure_builder::out,\n map(string, pzd_id)::in, map(string, pzd_id)::out,\n pz::in, pz::out) is det.\n\ngen_const_data_func(_ - Func, !LocnMap, !ModuleClo,\n !FilenameDataMap, !PZ) :-\n Filename = func_get_context(Func) ^ c_file,\n ( if not search(!.FilenameDataMap, Filename, _) then\n pz_new_data_id(FilenameDataId, !PZ),\n pz_add_data(FilenameDataId, pz_encode_string(Filename), !PZ),\n det_insert(Filename, FilenameDataId, !FilenameDataMap)\n else\n true\n ),\n\n ( if func_get_body(Func, _, _, _, Expr) then\n gen_const_data_expr(Expr, !LocnMap, !ModuleClo, !PZ)\n else\n true\n ).\n\n:- pred gen_const_data_expr(expr::in,\n val_locn_map_static::in, val_locn_map_static::out,\n closure_builder::in, closure_builder::out, pz::in, pz::out) is det.\n\ngen_const_data_expr(expr(ExprType, CodeInfo), !LocnMap, !ModuleClo, !PZ) :-\n ( ExprType = e_lets(Lets, Expr),\n foldl3(gen_const_data_lets, Lets, !LocnMap, !ModuleClo, !PZ),\n gen_const_data_expr(Expr, !LocnMap, !ModuleClo, !PZ)\n ; ExprType = e_tuple(Exprs),\n foldl3(gen_const_data_expr, Exprs, !LocnMap, !ModuleClo, !PZ)\n ; ExprType = e_call(_, _, _)\n ; ExprType = e_var(_)\n ; ExprType = e_constant(Const),\n ( Const = c_string(String),\n ( if\n [builtin_type(string)] = code_info_types(CodeInfo)\n then\n gen_const_data_string(String, !LocnMap, !ModuleClo, !PZ)\n else\n % The string literal is interpreted as a codepoint.\n true\n )\n ; Const = c_number(_)\n ; Const = c_func(_)\n ; Const = c_ctor(_)\n )\n ; ExprType = e_construction(_, _)\n ; ExprType = e_closure(_, _)\n ; ExprType = e_match(_, Cases),\n foldl3(gen_const_data_case, Cases, !LocnMap, !ModuleClo, !PZ)\n ).\n\n:- pred gen_const_data_lets(expr_let::in,\n val_locn_map_static::in, val_locn_map_static::out,\n closure_builder::in, closure_builder::out, pz::in, pz::out) is det.\n\ngen_const_data_lets(e_let(_, Expr), !LocnMap, !ModuleClo, !PZ) :-\n gen_const_data_expr(Expr, !LocnMap, !ModuleClo, !PZ).\n\n:- pred gen_const_data_case(expr_case::in,\n val_locn_map_static::in, val_locn_map_static::out,\n closure_builder::in, closure_builder::out, pz::in, pz::out) is det.\n\ngen_const_data_case(e_case(_, Expr), !LocnMap, !ModuleClo, !PZ) :-\n gen_const_data_expr(Expr, !LocnMap, !ModuleClo, !PZ).\n\n:- pred gen_const_data_string(string::in,\n val_locn_map_static::in, val_locn_map_static::out,\n closure_builder::in, closure_builder::out, pz::in, pz::out) is det.\n\ngen_const_data_string(String, !LocnMap, !ModuleClo, !PZ) :-\n ( if vls_has_str(!.LocnMap, String) then\n true\n else\n pz_new_data_id(DID, !PZ),\n pz_add_data(DID, pz_encode_string(String), !PZ),\n closure_add_field(pzv_data(DID), FieldNum, !ModuleClo),\n vls_insert_str(String, closure_get_struct(!.ModuleClo), FieldNum,\n type_to_pz_width(builtin_type(string)), !LocnMap)\n ).\n\n%-----------------------------------------------------------------------%\n\ngen_constructor_data(Core, BuiltinProcs, TypeTagMap, CtorTagMap,\n !PZ) :-\n Types = core_all_types(Core),\n foldl3(gen_constructor_data_type(Core, BuiltinProcs), Types,\n map.init, TypeTagMap, map.init, CtorTagMap, !PZ).\n\n:- pred gen_constructor_data_type(core::in, pz_builtin_ids::in,\n pair(type_id, user_type)::in,\n map(type_id, type_tag_info)::in, map(type_id, type_tag_info)::out,\n map({type_id, ctor_id}, constructor_data)::in,\n map({type_id, ctor_id}, constructor_data)::out,\n pz::in, pz::out) is det.\n\ngen_constructor_data_type(Core, BuiltinProcs, TypeId - Type, !TypeTagMap,\n !CtorDatas, !PZ) :-\n gen_constructor_tags(Core, Type, TypeTagInfo, CtorTagInfos, !PZ),\n\n det_insert(TypeId, TypeTagInfo, !TypeTagMap),\n\n MaybeCtorIds = utype_get_ctors(Type),\n ( MaybeCtorIds = yes(CtorIds),\n foldl2(gen_constructor_data_ctor(Core, BuiltinProcs, TypeId, Type,\n CtorTagInfos), CtorIds, !CtorDatas, !PZ)\n ; MaybeCtorIds = no\n % There's nothing to generate for abstractly-imported types\n ).\n\n:- pred gen_constructor_data_ctor(core::in, pz_builtin_ids::in,\n type_id::in, user_type::in, map(ctor_id, ctor_tag_info)::in, ctor_id::in,\n map({type_id, ctor_id}, constructor_data)::in,\n map({type_id, ctor_id}, constructor_data)::out,\n pz::in, pz::out) is det.\n\ngen_constructor_data_ctor(Core, BuiltinProcs, TypeId, Type, TagInfoMap,\n CtorId, !CtorDatas, !PZ) :-\n map.lookup(TagInfoMap, CtorId, TagInfo),\n\n maybe_gen_struct(Core, CtorId, TagInfo, !PZ),\n\n ModuleName = module_name(Core),\n core_get_constructor_det(Core, CtorId, Ctor),\n gen_constructor_proc(ModuleName, BuiltinProcs, Type, Ctor, TagInfo,\n ConstructProc, !PZ),\n\n CD = constructor_data(TagInfo, ConstructProc),\n map.det_insert({TypeId, CtorId}, CD, !CtorDatas).\n\n%-----------------------------------------------------------------------%\n\n:- pred maybe_gen_struct(core::in, ctor_id::in, ctor_tag_info::in,\n pz::in, pz::out) is det.\n\nmaybe_gen_struct(Core, CtorId, TagInfo, !PZ) :-\n core_get_constructor_det(Core, CtorId, Ctor),\n Fields = Ctor ^ c_fields,\n NumFields = length(Fields),\n ( if NumFields > 0 then\n (\n ( TagInfo = ti_constant(_, _)\n ; TagInfo = ti_constant_notag(_)\n ),\n unexpected($file, $pred, \"Constant can't have fields\")\n ; TagInfo = ti_tagged_pointer(_, StructId, MaybeSTag),\n ( MaybeSTag = yes(_),\n STagFields = 1\n ; MaybeSTag = no,\n STagFields = 0\n )\n ),\n duplicate(NumFields + STagFields, pzw_ptr, StructFields),\n Struct = pz_struct(StructFields),\n pz_add_struct(StructId, Struct, !PZ)\n else\n true\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred gen_constructor_proc(q_name::in, pz_builtin_ids::in,\n user_type::in, constructor::in, ctor_tag_info::in, pzp_id::out,\n pz::in, pz::out) is det.\n\ngen_constructor_proc(ModuleName, BuiltinProcs, Type, Ctor, TagInfo, ProcId,\n !PZ) :-\n % TODO Move the construction out-of-line into a separate procedure,\n % this is also used when the constructor is used as a higher order\n % value. It may be later inlined.\n ( TagInfo = ti_constant(PTag, WordBits),\n ShiftMakeTag = BuiltinProcs ^ pbi_shift_make_tag,\n Instrs = from_list([pzio_comment(\"Construct tagged constant\"),\n pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(WordBits))),\n pzio_instr(pzi_load_immediate(pzw_ptr,\n im_u32(cast_from_int(to_int(PTag))))),\n pzio_instr(pzi_call(pzc_import(ShiftMakeTag)))])\n ; TagInfo = ti_constant_notag(Word),\n Instrs = from_list([pzio_comment(\"Construct constant\"),\n pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(Word)))])\n ; TagInfo = ti_tagged_pointer(PTag, Struct, MaybeSTag),\n MakeTag = BuiltinProcs ^ pbi_make_tag,\n\n InstrsAlloc = from_list([pzio_comment(\"Construct struct\"),\n pzio_instr(pzi_alloc(Struct))]),\n\n list.map_foldl(gen_construction_store(Struct), Ctor ^ c_fields,\n InstrsStore0, FirstField, _),\n InstrsStore = cord.from_list(reverse(InstrsStore0)),\n\n ( MaybeSTag = no,\n FirstField = 1,\n InstrsPutTag = init\n ; MaybeSTag = yes(STag),\n FirstField = 2,\n InstrsPutTag = from_list([\n pzio_instr(pzi_load_immediate(pzw_ptr, im_u32(STag))),\n pzio_instr(pzi_roll(2)),\n pzio_instr(pzi_store(Struct, field_num(1), pzw_ptr))])\n ),\n\n InstrsTag = from_list([\n pzio_instr(pzi_load_immediate(pzw_ptr,\n im_u32(cast_from_int(to_int(PTag))))),\n pzio_instr(pzi_call(pzc_import(MakeTag)))]),\n\n Instrs = InstrsAlloc ++ InstrsStore ++ InstrsPutTag ++ InstrsTag\n ),\n\n pz_new_proc_id(ProcId, !PZ),\n TypeName = utype_get_name(Type),\n CtorName = Ctor ^ c_name,\n q_name_parts(CtorName, MaybeModuleName, CtorNameSingle),\n ( MaybeModuleName = yes(CtorModuleName),\n Name = q_name_append_str(ModuleName,\n format(\"construct_%s_%s_%s\",\n [s(replace_all(q_name_to_string(CtorModuleName), \".\", \"_\")),\n s(nq_name_to_string(q_name_unqual(TypeName))),\n s(nq_name_to_string(CtorNameSingle))]))\n ; MaybeModuleName = no,\n Name = q_name_append_str(ModuleName,\n format(\"construct_%s_%s\",\n [s(nq_name_to_string(q_name_unqual(TypeName))),\n s(nq_name_to_string(CtorNameSingle))]))\n ),\n Before = list.duplicate(length(Ctor ^ c_fields), pzw_ptr),\n After = [pzw_ptr],\n RetInstr = pzio_instr(pzi_ret),\n Proc = pz_proc(Name, pz_signature(Before, After),\n yes([pz_block(list(snoc(Instrs, RetInstr)))])),\n pz_add_proc(ProcId, Proc, !PZ).\n\n:- pred gen_construction_store(pzs_id::in, T::in,\n pz_instr_obj::out, int::in, int::out) is det.\n\ngen_construction_store(StructId, _, Instr, !FieldNo) :-\n Instr = pzio_instr(pzi_store(StructId, field_num(!.FieldNo), pzw_ptr)),\n !:FieldNo = !.FieldNo + 1.\n\n%-----------------------------------------------------------------------%\n%\n% Pointer tagging\n% ===============\n%\n% All memory allocations are machine-word aligned, this means that there are\n% two or three low-bits available for pointer tags (32bit or 64bit systems).\n% There may be high bits available also, especially on 64bit systems. For\n% now we assume that there are always two low bits available.\n%\n% TODO: Optimization\n% Using the third bit on a 64 bit system would be good. This can be handled\n% by compiling two versions of the program and storing them both in the .pz\n% file. One for 32-bit and one for 64-bit. This would happen at a late\n% stage of compilation and won't duplicate much work. It could be skipped\n% or stripped from the file to reduce file size if required.\n%\n% We use tagged pointers to implement discriminated unions. Most of what we\n% do here is based upon the Mercury project. Each pointer's 2 lowest bits\n% are the _primary tag_, a _secondary tag_ can be stored in the pointed-to\n% object when required.\n%\n% Each type's constructors are grouped into those that have arguments, and\n% those that do not. The first primary tag \"00\" is used for the group of\n% constants with the higher bits used to encode each constant. The\n% next remaining primary tags \"01\" \"10\" (and \"00\" if it was not used in the\n% first step\") are given to the first two-three constructors with arguments\n% and the final tag \"11\" is used for all the remaining constructors,\n% utilizing a second tag as the first field in the pointed-to structure to\n% distinguish between them.\n%\n% This scheme has a specific benefit that is if there is only a single\n% no-argument constructor then it has the same value as the null pointer.\n% Therefore the cons cell has the same encoding as either a normal pointer\n% or the null pointer. Likewise a maybe value can be unboxed in some cases.\n% (Not implemented yet).\n%\n% Exception: strict enums\n% If a type is an enum _only_ then it doesn't require any tag bits and is\n% encoded simply as a raw value. This exception enables the bool type to\n% use 0 and 1 conveniently.\n%\n% TODO: Optimisation:\n% Some types don't need to fill out the rest of the field for a given ptag.\n% For example something like:\n%\n% type Type = C1 Int | C2 | C3.\n%\n% Can use a primary tag for each of C1, C2 and C3. and have fewer switches.\n%\n% TODO: Optimisation:\n% Special casing certain types, such as unboxing maybes, handling \"no tag\"\n% types, etc.\n%\n% TODO: Optimisation:\n% Some constants, such as 0, should be able to share a primary tag with a\n% pointers.\n%\n%-----------------------------------------------------------------------%\n\n:- pred gen_constructor_tags(core::in, user_type::in,\n type_tag_info::out, map(ctor_id, ctor_tag_info)::out,\n pz::in, pz::out) is det.\n\ngen_constructor_tags(Core, Type, TypeTagInfo, !:CtorTagInfos, !PZ) :-\n MaybeCtorIds = utype_get_ctors(Type),\n ( MaybeCtorIds = yes(CtorIds),\n map((pred(CId::in, {CId, C}::out) is det :-\n core_get_constructor_det(Core, CId, C)\n ), CtorIds, Ctors),\n count_constructor_types(Ctors, NumNoArgs, NumWithArgs),\n ( if NumWithArgs = 0 then\n % This is a simple enum and therefore we can use strict enum\n % tagging.\n TypeTagInfo = tti_untagged,\n map_foldl(make_strict_enum_tag_info, CtorIds, CtorTagInfos, 0u32, _),\n !:CtorTagInfos =\n from_assoc_list(from_corresponding_lists(CtorIds, CtorTagInfos))\n else\n !:CtorTagInfos = map.init,\n some [!PTagMap] (\n !:PTagMap = map.init,\n ( if NumNoArgs \\= 0 then\n foldl3(make_enum_tag_info(0u8), Ctors, 0u32, _, !CtorTagInfos,\n !PTagMap),\n NextPTag = 1u8\n else\n NextPTag = 0u8\n ),\n ( if\n % We need secondary tags if there are more than\n % num_ptag_vals constructors with fields plus a ptag for the\n % constructors without fields.\n (\n NumNoArgs = 0,\n NumWithArgs > num_ptag_vals\n ;\n NumNoArgs \\= 0,\n NumWithArgs + 1 > num_ptag_vals\n )\n then\n NeedSecTags = need_secondary_tags\n else\n NeedSecTags = dont_need_secondary_tags\n ),\n TypeName = utype_get_name(Type),\n foldl5(make_ctor_tag_info(TypeName, NeedSecTags), Ctors,\n NextPTag, _, 0u32, _, !CtorTagInfos, !PTagMap, !PZ),\n TypeTagInfo = tti_tagged(!.PTagMap)\n )\n )\n ; MaybeCtorIds = no,\n % We don't create constructor tags for abstractly-imported types.\n TypeTagInfo = tti_abstract,\n !:CtorTagInfos = init\n ).\n\n:- pred count_constructor_types(list({ctor_id, constructor})::in,\n int::out, int::out) is det.\n\ncount_constructor_types([], 0, 0).\ncount_constructor_types([{_, Ctor} | Ctors], NumNoArgs,\n NumWithArgs) :-\n count_constructor_types(Ctors, NumNoArgs0, NumWithArgs0),\n Args = Ctor ^ c_fields,\n ( Args = [],\n NumNoArgs = NumNoArgs0 + 1,\n NumWithArgs = NumWithArgs0\n ; Args = [_ | _],\n NumNoArgs = NumNoArgs0,\n NumWithArgs = NumWithArgs0 + 1\n ).\n\n % make_enum_tag_info(PTag, Ctor, ThisWordBits, NextWordBits,\n % !TagInfoMap).\n %\n:- pred make_enum_tag_info(ptag::in, {ctor_id, constructor}::in,\n word_bits::in, word_bits::out,\n map(ctor_id, ctor_tag_info)::in, map(ctor_id, ctor_tag_info)::out,\n map(ptag, type_ptag_info)::in, map(ptag, type_ptag_info)::out) is det.\n\nmake_enum_tag_info(PTag, {CtorId, Ctor}, !WordBits, !CtorTagMap,\n !TypePTagMap) :-\n Fields = Ctor ^ c_fields,\n ( Fields = [],\n det_insert(CtorId, ti_constant(PTag, !.WordBits), !CtorTagMap),\n add_ptag_constant(PTag, !.WordBits, CtorId, !TypePTagMap),\n !:WordBits = !.WordBits + 1u32\n ; Fields = [_ | _]\n ).\n\n % make_strict_enum_tag_info(Ctor, ThisWordBits, NextWordBits,\n % !TagInfoMap).\n %\n:- pred make_strict_enum_tag_info(ctor_id::in, ctor_tag_info::out,\n word_bits::in, word_bits::out) is det.\n\nmake_strict_enum_tag_info(_, TagInfo, !WordBits) :-\n TagInfo = ti_constant_notag(!.WordBits),\n !:WordBits = !.WordBits + 1u32.\n\n % Used to inform make_ctor_tag_info if secondary tags will be used some\n % constructors of this type. This is used to deterime if the first\n % constructor to use the final primary tag should have a secondary tag\n % to differentiate itself from further constructors that would share the\n % primary tag. If no further constructors exist, then a secondary tag\n % isn't required.\n %\n:- type need_secondary_tags\n ---> need_secondary_tags\n ; dont_need_secondary_tags.\n\n:- pred make_ctor_tag_info(q_name::in, need_secondary_tags::in,\n {ctor_id, constructor}::in, ptag::in, ptag::out, stag::in, stag::out,\n map(ctor_id, ctor_tag_info)::in, map(ctor_id, ctor_tag_info)::out,\n map(ptag, type_ptag_info)::in, map(ptag, type_ptag_info)::out,\n pz::in, pz::out) is det.\n\nmake_ctor_tag_info(TypeName, NeedSecTag, {CtorId, Ctor}, !PTag, !STag,\n !CtorTagMap, !TypePTagMap, !PZ) :-\n Fields = Ctor ^ c_fields,\n ( Fields = []\n ; Fields = [_ | _],\n StructName = q_name_to_string(TypeName) ++ \"_\" ++\n q_name_to_string(Ctor ^ c_name),\n pz_new_struct_id(StructId, StructName, !PZ),\n ( if\n (\n !.PTag < det_from_int(num_ptag_vals - 1)\n ;\n !.PTag = det_from_int(num_ptag_vals - 1),\n NeedSecTag = dont_need_secondary_tags\n )\n then\n det_insert(CtorId, ti_tagged_pointer(!.PTag, StructId, no),\n !CtorTagMap),\n det_insert(!.PTag, tpti_pointer(CtorId), !TypePTagMap),\n !:PTag = !.PTag + 1u8\n else\n det_insert(CtorId, ti_tagged_pointer(!.PTag, StructId, yes(!.STag)),\n !CtorTagMap),\n add_ptag_stag(!.PTag, !.STag, CtorId, !TypePTagMap),\n !:STag = !.STag + 1u32\n )\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred add_ptag_constant(ptag::in, word_bits::in, ctor_id::in,\n map(ptag, type_ptag_info)::in, map(ptag, type_ptag_info)::out) is det.\n\nadd_ptag_constant(PTag, Constant, CtorId, !Map) :-\n ( if search(!.Map, PTag, Entry0) then\n ( Entry0 = tpti_constant(ConstMap0)\n ;\n ( Entry0 = tpti_pointer(_)\n ; Entry0 = tpti_pointer_stag(_)\n ),\n unexpected($file, $pred,\n \"Constants and pointers cannot share a ptag\")\n )\n else\n ConstMap0 = map.init\n ),\n det_insert(Constant, CtorId, ConstMap0, ConstMap),\n set(PTag, tpti_constant(ConstMap), !Map).\n\n:- pred add_ptag_stag(ptag::in, stag::in, ctor_id::in,\n map(ptag, type_ptag_info)::in, map(ptag, type_ptag_info)::out) is det.\n\nadd_ptag_stag(PTag, STag, CtorId, !Map) :-\n ( if search(!.Map, PTag, Entry0) then\n ( Entry0 = tpti_pointer_stag(STagMap0)\n ;\n ( Entry0 = tpti_pointer(_)\n ; Entry0 = tpti_constant(_)\n ),\n unexpected($file, $pred,\n \"If one ctor for this ptag has an stag, then all must.\")\n )\n else\n STagMap0 = map.init\n ),\n det_insert(STag, CtorId, STagMap0, STagMap),\n set(PTag, tpti_pointer_stag(STagMap), !Map).\n\n%-----------------------------------------------------------------------%\n\n% This prints the data representation in a way that it can be used for\n% reference, not in a way to cross-check that it's correct.\n\ndata_rep_pretty({Core, TypeTagMap, CtorTagMap}) =\n pretty(default_options, 0, Pretty) :-\n ModuleDecl = p_expr(\n [p_str(\"module\"), p_spc, q_name_pretty(module_name(Core))]),\n BoolWidth = p_expr(p_words(\"bool width is\") ++\n [p_spc, p_str(string(data.bool_width))]),\n PTagBits = p_expr(\n p_words(format(\"There are %d primary tag bits for %d primary tags.\",\n [i(num_ptag_bits), i(num_ptag_vals)]))),\n TypeTagMapPretty = pretty_seperated([p_nl_double],\n map(type_tag_pretty(Core, CtorTagMap),\n map.to_assoc_list(TypeTagMap))),\n Pretty = [p_list([ModuleDecl, p_nl_double,\n BoolWidth, p_nl_hard,\n PTagBits, p_nl_double]\n ++ TypeTagMapPretty)].\n\n:- func type_tag_pretty(core, constructor_data_map,\n pair(type_id, type_tag_info)) = pretty.\n\ntype_tag_pretty(Core, CtorTagMap, TypeId - TTI) =\n p_expr([p_str(\"type\"), p_spc, q_name_pretty(TypeName),\n p_str(\" - \"), p_str(TTIStr)] ++ More) :-\n TypeName = core_lookup_type_name(Core, TypeId),\n ( TTI = tti_untagged,\n TTIStr = \"untagged\",\n MaybeCtors = utype_get_ctors(core_get_type(Core, TypeId)),\n ( MaybeCtors = yes(Ctors)\n ; MaybeCtors = no,\n unexpected($file, $pred, \"Abstract\")\n ),\n More = [p_nl_hard] ++ pretty_seperated([p_nl_hard],\n map(untagged_ctor_pretty(Core, CtorTagMap, TypeId), Ctors))\n ; TTI = tti_tagged(TagInfoMap),\n TTIStr = \"tagged\",\n More = [p_nl_hard] ++ pretty_seperated([p_nl_hard],\n map(ptag_pretty(Core), to_assoc_list(TagInfoMap)))\n ; TTI = tti_abstract,\n TTIStr = \"abstract\",\n More = []\n ).\n\n:- func untagged_ctor_pretty(core, constructor_data_map, type_id, ctor_id) =\n pretty.\n\nuntagged_ctor_pretty(Core, CtorMap, TypeId, CtorId) =\n p_expr([p_ctor(Core, CtorId), p_str(\" - \"), p_str(string(Bits))]) :-\n CtorTagInfo = lookup(CtorMap, {TypeId, CtorId}) ^ cd_tag_info,\n (\n ( CtorTagInfo = ti_constant(_, _)\n ; CtorTagInfo = ti_tagged_pointer(_, _, _)\n ),\n unexpected($file, $pred, \"Tagged\")\n ; CtorTagInfo = ti_constant_notag(Bits)\n ).\n\n:- func ptag_pretty(core, pair(ptag, type_ptag_info)) = pretty.\n\nptag_pretty(Core, PTag - Info) =\n p_expr([p_str(\"ptag\"), p_spc, p_str(string(PTag)), p_str(\": \")] ++\n ptag_info_pretty(Core, Info)).\n\n:- func ptag_info_pretty(core, type_ptag_info) = list(pretty).\n\nptag_info_pretty(Core, tpti_constant(Map)) =\n p_words(\"Non-tag bits are a constant\") ++\n [p_nl_hard, p_list(map(bits_ctor_pretty(Core), to_assoc_list(Map)))].\nptag_info_pretty(Core, tpti_pointer(Ctor)) =\n p_words(\"pointer for\") ++ [p_spc, p_ctor(Core, Ctor)].\nptag_info_pretty(Core, tpti_pointer_stag(Map)) =\n map(stag_ctor_pretty(Core), to_assoc_list(Map)).\n\n:- func bits_ctor_pretty(core, pair(word_bits, ctor_id)) = pretty.\n\nbits_ctor_pretty(Core, Bits - Ctor) =\n p_expr([p_str(string(Bits)), p_str(\" - \"), p_ctor(Core, Ctor)]).\n\n:- func stag_ctor_pretty(core, pair(stag, ctor_id)) = pretty.\n\nstag_ctor_pretty(Core, Stag - Ctor) =\n p_expr([p_str(string(Stag)), p_str(\" - \"), p_ctor(Core, Ctor)]).\n\n:- func p_ctor(core, ctor_id) = pretty.\n\np_ctor(Core, CtorId) =\n q_name_pretty(core_lookup_constructor_name(Core, CtorId)).\n\n%-----------------------------------------------------------------------%\n\n% This must be equal to or less than the number of taog bits set in the\n% runtime. See runtime/pz_run.h.\nnum_ptag_bits = 2.\n\n:- func num_ptag_vals = int.\n\nnum_ptag_vals = pow(2, num_ptag_bits).\n\n%-----------------------------------------------------------------------%\n\ntype_to_pz_width(Type) = Width :-\n ( Type = builtin_type(BuiltinType),\n ( BuiltinType = int,\n Width = pzw_fast\n ; BuiltinType = codepoint,\n Width = pzw_32\n ; BuiltinType = string,\n Width = pzw_ptr\n ; BuiltinType = string_pos,\n Width = pzw_ptr\n )\n ;\n ( Type = type_variable(_)\n ; Type = type_ref(_, _)\n ; Type = func_type(_, _, _, _)\n ),\n Width = pzw_ptr\n ).\n\n% This must match the calculation above, and is provided to avoid a\n% dependency in builtins.m\nbool_width = pzw_ptr.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core_to_pz.locn.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core_to_pz.locn.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Plasma core to pz conversion - value location information\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module cord.\n:- import_module maybe.\n\n%-----------------------------------------------------------------------%\n\n % The location of a value, this is made of two types.\n %\n % val_locn says where to start looking, either on the stack or with the\n % current environment. Once you have then then...\n %\n % val_locn_next says what to do with the current location, if you're\n % done or weather you should follow some structure.\n %\n:- type val_locn\n % The value is on the stack.\n ---> vl_stack(int, val_locn_next)\n % The value _is_ the current env.\n ; vl_env(val_locn_next)\n % The value needs to be computed using this expression.\n ; vl_compute(expr).\n\n:- type val_locn_next\n ---> vln_done\n % The value is within some structure (like the environment).\n ; vln_struct(pzs_id, field_num, pz_width, val_locn_next).\n\n:- type proc_locn\n ---> pl_instrs(list(pz_instr), maybe(pzp_id))\n ; pl_static_proc(pzp_id)\n ; pl_other(val_locn).\n\n%-----------------------------------------------------------------------%\n%\n% The location map information is divided into two halves, the static\n% information which is static per PZ procedure. And the dynamic\n% information, which changes with code generation (for example as values are\n% pushed onto the stack).\n%\n\n:- type val_locn_map_static.\n\n:- func vls_init(pzs_id) = val_locn_map_static.\n\n:- pred vls_set_proc(func_id::in, pzp_id::in,\n val_locn_map_static::in, val_locn_map_static::out) is det.\n\n:- pred vls_set_proc_instrs(func_id::in, list(pz_instr)::in,\n val_locn_map_static::in, val_locn_map_static::out) is det.\n\n:- pred vls_set_proc_imported(func_id::in, pzi_id::in, field_num::in,\n val_locn_map_static::in, val_locn_map_static::out) is det.\n\n:- func vls_lookup_proc_id(val_locn_map_static, func_id) = pzp_id.\n\n:- pred vls_set_closure(func_id::in, pzs_id::in,\n val_locn_map_static::in, val_locn_map_static::out) is det.\n\n:- func vls_lookup_closure(val_locn_map_static, func_id) = pzs_id.\n\n:- pred vls_has_str(val_locn_map_static::in, string::in) is semidet.\n\n:- pred vls_insert_str(string::in, pzs_id::in, field_num::in, pz_width::in,\n val_locn_map_static::in, val_locn_map_static::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- type val_locn_map.\n\n:- pred vl_start_var_binding(val_locn_map_static::in, val_locn_map::out)\n is det.\n\n % vl_setup_closure(StructId, FieldNo, !LocnMap).\n %\n % The code using !:LocnMap map executes within a closure. The root\n % (module) environment can be found by dereferencing the environment\n % using FieldNo of StructId.\n:- pred vl_setup_closure(pzs_id::in, field_num::in,\n val_locn_map::in, val_locn_map::out) is det.\n\n:- pred vl_put_var(var::in, int::in, val_locn_map::in, val_locn_map::out)\n is det.\n\n:- pred vl_set_var_env(var::in, pzs_id::in, field_num::in, pz_width::in,\n val_locn_map::in, val_locn_map::out) is det.\n\n:- pred vl_set_var_expr(var::in, expr::in,\n val_locn_map::in, val_locn_map::out) is det.\n\n:- pred vl_put_vars(list(var)::in, int::in, varmap::in,\n cord(pz_instr_obj)::out, val_locn_map::in, val_locn_map::out) is det.\n\n:- func vl_lookup_proc(val_locn_map, func_id) = proc_locn.\n\n:- func vl_lookup_proc_id(val_locn_map, func_id) = pzp_id.\n\n:- func vl_lookup_closure(val_locn_map, func_id) = pzs_id.\n\n % This is semidet so our caller can give a clearer exception if it\n % fails.\n %\n:- pred vl_search_var(val_locn_map::in, var::in, val_locn::out) is semidet.\n\n:- func vl_lookup_str(val_locn_map, string) = val_locn.\n\n:- func vl_lookup_mod_env(val_locn_map) = val_locn.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module int.\n\n%-----------------------------------------------------------------------%\n\n:- type val_locn_map_static\n ---> val_locn_map_static(\n vls_mod_env :: pzs_id,\n vls_const_data :: map(const_data, val_locn),\n vls_proc_id_map :: map(func_id, proc_locn_internal),\n\n % Not exactly location data, but it is accessed and created\n % similarly.\n vls_closures :: map(func_id, pzs_id)\n ).\n\n % Used internally. proc_locn is just how the the result is returned.\n %\n:- type proc_locn_internal\n ---> pli_instrs(list(pz_instr), maybe(pzp_id))\n ; pli_static_proc(pzp_id)\n ; pli_import(pzi_id, field_num).\n\n%-----------------------------------------------------------------------%\n\nvls_init(ModEnvStruct) = val_locn_map_static(ModEnvStruct, init, init, init).\n\n%-----------------------------------------------------------------------%\n\nvls_set_proc(FuncId, ProcId, !Map) :-\n ( if search(!.Map ^ vls_proc_id_map, FuncId, Locn0) then\n (\n ( Locn0 = pli_static_proc(_)\n ; Locn0 = pli_import(_, _)\n ),\n unexpected($file, $pred, \"Already set\")\n ; Locn0 = pli_instrs(Instrs, MaybeProc),\n ( MaybeProc = yes(_),\n unexpected($file, $pred, \"Already set\")\n ; MaybeProc = no,\n Locn = pli_instrs(Instrs, yes(ProcId))\n )\n )\n else\n Locn = pli_static_proc(ProcId)\n ),\n map.set(FuncId, Locn, !.Map ^ vls_proc_id_map, ProcMap),\n !Map ^ vls_proc_id_map := ProcMap.\n\nvls_set_proc_instrs(FuncId, Instrs, !Map) :-\n ( if search(!.Map ^ vls_proc_id_map, FuncId, Locn0) then\n (\n ( Locn0 = pli_instrs(_, _)\n ; Locn0 = pli_import(_, _)\n ),\n unexpected($file, $pred, \"Already set\")\n ; Locn0 = pli_static_proc(ProcId),\n Locn = pli_instrs(Instrs, yes(ProcId))\n )\n else\n Locn = pli_instrs(Instrs, no)\n ),\n map.set(FuncId, Locn, !.Map ^ vls_proc_id_map, ProcMap),\n !Map ^ vls_proc_id_map := ProcMap.\n\nvls_set_proc_imported(FuncId, ImportId, FieldNum, !Map) :-\n map.det_insert(FuncId, pli_import(ImportId, FieldNum),\n !.Map ^ vls_proc_id_map, ProcMap),\n !Map ^ vls_proc_id_map := ProcMap.\n\n%-----------------------------------------------------------------------%\n\nvls_lookup_proc_id(Map, FuncId) = ProcId :-\n map.lookup(Map ^ vls_proc_id_map, FuncId, Locn),\n ( Locn = pli_static_proc(ProcId)\n ; Locn = pli_instrs(_, MaybeProcId),\n ( MaybeProcId = yes(ProcId)\n ; MaybeProcId = no,\n unexpected($file, $pred, \"Builtin with no proc\")\n )\n ; Locn = pli_import(_, _),\n unexpected($file, $pred, \"Non-static proc\")\n ).\n\n%-----------------------------------------------------------------------%\n\nvls_set_closure(FuncId, EnvStructId, !Map) :-\n map.det_insert(FuncId, EnvStructId, !.Map ^ vls_closures, ClosuresMap),\n !Map ^ vls_closures := ClosuresMap.\n\nvls_lookup_closure(Map, FuncId) = EnvStructId :-\n map.lookup(Map ^ vls_closures, FuncId, EnvStructId).\n\n%-----------------------------------------------------------------------%\n\nvls_has_str(Map, Str) :-\n map.contains(Map ^ vls_const_data, cd_string(Str)).\n\n%-----------------------------------------------------------------------%\n\nvls_insert_str(String, Struct, Field, Width, !Map) :-\n map.det_insert(cd_string(String),\n vl_env(vln_struct(Struct, Field, Width, vln_done)),\n !.Map ^ vls_const_data, ConstMap),\n !Map ^ vls_const_data := ConstMap.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- type val_locn_map\n ---> vlm_root(\n vlmr_static :: val_locn_map_static,\n vlmr_vars :: map(var, val_locn)\n )\n ; vlm_clos(\n vlme_static :: val_locn_map_static,\n vlme_vars :: map(var, val_locn),\n vlme_struct :: pzs_id,\n vlme_field :: field_num,\n vlme_width :: pz_width\n ).\n\n%-----------------------------------------------------------------------%\n\nvl_start_var_binding(Static, vlm_root(Static, map.init)).\n\n%-----------------------------------------------------------------------%\n\nvl_setup_closure(Struct, Field, vlm_root(Static, Vars),\n vlm_clos(Static, Vars, Struct, Field, pzw_ptr)).\nvl_setup_closure(_, _, vlm_clos(_, _, _, _, _), _) :-\n unexpected($file, $pred, \"Closures must be flat\").\n\n%-----------------------------------------------------------------------%\n\nvl_put_var(Var, Depth, !Map) :-\n vl_set_var_1(Var, vl_stack(Depth, vln_done), !Map).\n\nvl_set_var_env(Var, Struct, Field, Width, !Map) :-\n vl_set_var_1(Var, vl_env(vln_struct(Struct, Field, Width, vln_done)), !Map).\n\nvl_set_var_expr(Var, Expr, !Map) :-\n vl_set_var_1(Var, vl_compute(Expr), !Map).\n\n%-----------------------------------------------------------------------%\n\nvl_put_vars([], _, _, init, !Map).\nvl_put_vars([Var | Vars], Depth0, Varmap, Comments, !Map) :-\n Depth = Depth0 + 1,\n vl_put_var(Var, Depth, !Map),\n Comment = pzio_comment(format(\"%s is at depth %d\",\n [s(get_var_name(Varmap, Var)), i(Depth)])),\n vl_put_vars(Vars, Depth, Varmap, Comments0, !Map),\n Comments = cons(Comment, Comments0).\n\n%-----------------------------------------------------------------------%\n\n:- pred vl_set_var_1(var::in, val_locn::in,\n val_locn_map::in, val_locn_map::out) is det.\n\nvl_set_var_1(Var, Locn,\n vlm_root(Static, !.VarsMap), vlm_root(Static, !:VarsMap)) :-\n map.det_insert(Var, Locn, !VarsMap).\nvl_set_var_1(Var, Locn,\n vlm_clos(Sta, !.VarsMap, Str, F, W),\n vlm_clos(Sta, !:VarsMap, Str, F, W)) :-\n map.det_insert(Var, Locn, !VarsMap).\n\n%-----------------------------------------------------------------------%\n\nvl_lookup_proc(vlm_root(Static, _), FuncId) = Locn :-\n map.lookup(Static ^ vls_proc_id_map, FuncId, Locn0),\n Locn = proc_locn_from_internal(Static ^ vls_mod_env, Locn0).\nvl_lookup_proc(vlm_clos(Static, _, Struct, Field, Width), FuncId) = Locn :-\n map.lookup(Static ^ vls_proc_id_map, FuncId, Locn0),\n Locn1 = proc_locn_from_internal(Static ^ vls_mod_env, Locn0),\n Locn = proc_maybe_in_struct(Struct, Field, Width, Locn1).\n\nvl_lookup_proc_id(LocnMap, FuncId) =\n vls_lookup_proc_id(vl_static(LocnMap), FuncId).\n\n%-----------------------------------------------------------------------%\n\nvl_lookup_closure(LocnMap, FuncId) = StructId :-\n map.lookup(vl_static(LocnMap) ^ vls_closures, FuncId, StructId).\n\n%-----------------------------------------------------------------------%\n\nvl_search_var(vlm_root(_, VarsMap), Var, Locn) :-\n map.search(VarsMap, Var, Locn).\nvl_search_var(vlm_clos(_, VarsMap, _, _, _), Var, Locn) :-\n map.search(VarsMap, Var, Locn).\n\n%-----------------------------------------------------------------------%\n\nvl_lookup_str(vlm_root(Static, _), Str) = Locn :-\n map.lookup(Static ^ vls_const_data, cd_string(Str), Locn).\nvl_lookup_str(vlm_clos(Static, _, Struct, Field, Width), Str) =\n val_maybe_in_struct(Struct, Field, Width, Locn0) :-\n map.lookup(Static ^ vls_const_data, cd_string(Str), Locn0).\n\n%-----------------------------------------------------------------------%\n\nvl_lookup_mod_env(vlm_root(_, _)) = vl_env(vln_done).\nvl_lookup_mod_env(vlm_clos(_, _, S, F, W)) =\n vl_env(vln_struct(S, F, W, vln_done)).\n\n%-----------------------------------------------------------------------%\n\n:- func proc_locn_from_internal(pzs_id, proc_locn_internal) = proc_locn.\n\nproc_locn_from_internal(_, pli_instrs(Instrs, MbProcId)) =\n pl_instrs(Instrs, MbProcId).\nproc_locn_from_internal(_, pli_static_proc(ProcId)) = pl_static_proc(ProcId).\nproc_locn_from_internal(ModEnvStruct, pli_import(_, FieldNum)) =\n pl_other(vl_env(vln_struct(ModEnvStruct, FieldNum, pzw_ptr, vln_done))).\n\n:- func proc_maybe_in_struct(pzs_id, field_num, pz_width, proc_locn) =\n proc_locn.\n\nproc_maybe_in_struct(Struct, Field, Width, Locn0) = Locn :-\n (\n ( Locn0 = pl_instrs(_, _)\n ; Locn0 = pl_static_proc(_)\n ),\n Locn = Locn0\n ; Locn0 = pl_other(ValLocn0),\n Locn = pl_other(val_maybe_in_struct(Struct, Field, Width, ValLocn0))\n ).\n\n:- func val_maybe_in_struct(pzs_id, field_num, pz_width, val_locn) = val_locn.\n\nval_maybe_in_struct(_, _, _, Val@vl_stack(_, _)) = Val.\nval_maybe_in_struct(_, _, _, Val@vl_compute(_)) = Val.\nval_maybe_in_struct(StructId, Field, Width, vl_env(Next0)) =\n vl_env(vln_struct(StructId, Field, Width, Next0)).\n\n:- func vl_static(val_locn_map) = val_locn_map_static.\n\nvl_static(vlm_root(Static, _)) = Static.\nvl_static(vlm_clos(Static, _, _, _, _)) = Static.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/core_to_pz.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module core_to_pz.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Plasma core to pz conversion\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- include_module core_to_pz.data.\n\n:- import_module io.\n\n:- import_module core.\n:- import_module core_to_pz.data.\n:- import_module options.\n:- import_module pz.\n:- import_module pz.pz_ds.\n:- import_module util.\n:- import_module util.log.\n\n%-----------------------------------------------------------------------%\n\n:- pred core_to_pz(log_config::in, compile_options::in, core::in, pz::out,\n type_tag_map::out, constructor_data_map::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n\n:- func bool_width = pz_width.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module cord.\n:- import_module list.\n:- import_module map.\n:- import_module pair.\n:- import_module require.\n:- import_module set.\n:- import_module string.\n\n:- import_module builtins.\n:- import_module common_types.\n:- import_module core.code.\n:- import_module core.function.\n:- import_module core.types.\n:- import_module pz.code.\n:- import_module q_name.\n:- import_module util.mercury.\n:- import_module util.pretty.\n:- import_module varmap.\n\n:- include_module core_to_pz.code.\n:- include_module core_to_pz.closure.\n:- include_module core_to_pz.locn.\n:- import_module core_to_pz.code.\n:- import_module core_to_pz.closure.\n:- import_module core_to_pz.locn.\n\n%-----------------------------------------------------------------------%\n\ncore_to_pz(Verbose, CompileOpts, !.Core, !:PZ, TypeTagMap, TypeCtorTagMap,\n !IO) :-\n !:PZ = init_pz([module_name(!.Core)], pzft_object),\n\n % Get ImportIds for builtin procedures.\n setup_pz_builtin_procs(BuiltinProcs, !PZ),\n\n % Make decisions about how data should be stored in memory.\n % This covers what tag values to use for each constructor and the IDs of\n % each structure.\n pz_new_struct_id(EnvStructId, \"Module struct\", !PZ),\n verbose_output(Verbose, \"Generating type layout (constructor tags)\\n\",\n !IO),\n gen_constructor_data(!.Core, BuiltinProcs, TypeTagMap, TypeCtorTagMap,\n !PZ),\n\n some [!ModuleClo, !LocnMap, !FilenameDataMap] (\n !:ModuleClo = closure_builder_init(EnvStructId),\n !:LocnMap = vls_init(EnvStructId),\n !:FilenameDataMap = map.init,\n\n % Generate constants.\n verbose_output(Verbose, \"Generating constants\\n\", !IO),\n gen_const_data(!.Core, !LocnMap, !ModuleClo, !FilenameDataMap, !PZ),\n\n % Generate functions.\n Funcs = core_all_functions(!.Core),\n foldl3(make_proc_and_struct_ids, Funcs, !LocnMap, !ModuleClo, !PZ),\n DefinedFuncs = core_all_defined_functions(!.Core),\n verbose_output(Verbose,\n format(\"Generating %d functions\\n\", [i(length(DefinedFuncs))]),\n !IO),\n foldl(gen_func(CompileOpts, !.Core, !.LocnMap, BuiltinProcs,\n !.FilenameDataMap, TypeTagMap, TypeCtorTagMap, EnvStructId),\n DefinedFuncs, !PZ),\n\n % Finalize the module closure.\n verbose_output(Verbose, \"Generating module closure\\n\", !IO),\n closure_finalize_data(!.ModuleClo, EnvDataId, !PZ),\n ExportFuncs0 = core_all_exported_functions(!.Core),\n\n % Export and mark the entrypoint.\n verbose_output(Verbose, \"Generating entrypoint and exports\\n\", !IO),\n Candidates = core_entry_candidates(!.Core),\n set.fold(create_entry_candidate(!.Core, !.LocnMap, EnvDataId),\n Candidates, !PZ),\n CandidateIDs = map(entry_get_func_id, Candidates),\n ExportFuncs = filter(\n pred(Id - _::in) is semidet :- not member(Id, CandidateIDs),\n ExportFuncs0),\n\n % Export the other exported functions.\n map_foldl(create_export(!.LocnMap, EnvDataId), ExportFuncs, _, !PZ)\n ).\n\n:- func entry_get_func_id(core_entrypoint) = func_id.\n\nentry_get_func_id(entry_plain(FuncId)) = FuncId.\nentry_get_func_id(entry_argv(FuncId)) = FuncId.\n\n:- pred create_entry_candidate(core::in, val_locn_map_static::in,\n pzd_id::in, core_entrypoint::in, pz::in, pz::out) is det.\n\ncreate_entry_candidate(Core, LocnMap, EnvDataId, Entrypoint, !PZ) :-\n ( Entrypoint = entry_plain(EntryFuncId),\n Signature = pz_es_plain\n ; Entrypoint = entry_argv(EntryFuncId),\n Signature = pz_es_args\n ),\n core_get_function_det(Core, EntryFuncId, EntryFunc),\n create_export(LocnMap, EnvDataId,\n EntryFuncId - EntryFunc, EntryClo, !PZ),\n pz_add_entry_candidate(EntryClo, Signature, !PZ).\n\n:- pred create_export(val_locn_map_static::in, pzd_id::in,\n pair(func_id, function)::in, pzc_id::out, pz::in, pz::out) is det.\n\ncreate_export(LocnMap, ModuleDataId, FuncId - Function, ClosureId, !PZ) :-\n ProcId = vls_lookup_proc_id(LocnMap, FuncId),\n pz_new_closure_id(ClosureId, !PZ),\n pz_add_closure(ClosureId, pz_closure(ProcId, ModuleDataId), !PZ),\n pz_export_closure(ClosureId, func_get_name(Function), !PZ).\n\n%-----------------------------------------------------------------------%\n\n % Create proc and struct IDs for functions and any closure environments\n % they require, add these to maps and return them.\n %\n:- pred make_proc_and_struct_ids(pair(func_id, function)::in,\n val_locn_map_static::in, val_locn_map_static::out,\n closure_builder::in, closure_builder::out, pz::in, pz::out) is det.\n\nmake_proc_and_struct_ids(FuncId - Function, !LocnMap, !BuildModClosure, !PZ) :-\n Name = q_name_to_string(func_get_name(Function)),\n ShouldGenerate = should_generate(Function),\n ( ShouldGenerate = need_codegen,\n assert_has_body(Function),\n make_proc_id_core_or_rts(FuncId, Function, !LocnMap,\n !BuildModClosure, !PZ)\n ; ShouldGenerate = need_inline_pz_and_codegen,\n ( if func_builtin_inline_pz(Function, PZInstrs) then\n vls_set_proc_instrs(FuncId, PZInstrs, !LocnMap)\n else\n unexpected($file, $pred, format(\n \"Inline PZ builtin ('%s') without list of instructions\",\n [s(Name)]))\n ),\n\n assert_has_body(Function),\n make_proc_id_core_or_rts(FuncId, Function, !LocnMap,\n !BuildModClosure, !PZ)\n ; ShouldGenerate = need_extern_import,\n assert_has_no_body(Function),\n make_proc_id_core_or_rts(FuncId, Function, !LocnMap,\n !BuildModClosure, !PZ)\n ; ShouldGenerate = need_extern_local,\n assert_has_no_body(Function),\n make_proc_id_foreign(FuncId, Function, !LocnMap, !BuildModClosure, !PZ)\n ; ShouldGenerate = dead_code\n ),\n\n Captured = func_get_captured_vars_types(Function),\n ( Captured = []\n ; Captured = [_ | _],\n pz_new_struct_id(EnvStructId, \"Closure of \" ++ Name, !PZ),\n vls_set_closure(FuncId, EnvStructId, !LocnMap),\n EnvStruct = pz_struct([pzw_ptr | map(type_to_pz_width, Captured)]),\n pz_add_struct(EnvStructId, EnvStruct, !PZ)\n ).\n\n:- type generate\n % We need to do codegen for this function. Eg it is a function\n % defined in this module.\n ---> need_codegen\n\n % We need to map calls to this function to a sequence of pz\n % instructions, but also generate a body for it. Eg: it is a\n % builtin operator and could be called directly (replace with\n % instructions) or used as a higher order value (provide a\n % pointer).\n ; need_inline_pz_and_codegen\n\n % The body of this function is defined externally (eg builtin\n % code), and it is imported from another module: we don't need\n % to create a symbol for linking.\n ; need_extern_import\n\n % The body of this function is defined externally (eg foreign\n % code), but it belongs to this module and we need to tell the\n % linker that the definition will be provided at runtime.\n ; need_extern_local\n\n % No codegen or linking at all.\n ; dead_code.\n\n:- func should_generate(function) = generate.\n\nshould_generate(Function) = Generate :-\n IsUsed = func_get_used(Function),\n ( IsUsed = used_probably,\n CodeType = func_get_code_type(Function),\n ( CodeType = ct_foreign,\n Generate = need_extern_local\n ; CodeType = ct_builtin(BuiltinType),\n ( BuiltinType = bit_core,\n Generate = need_codegen\n ; BuiltinType = bit_inline_pz,\n % Everything with inline PZ also gets codegen. TODO we\n % should check if address is taken to skip that most of the\n % time.\n Generate = need_inline_pz_and_codegen\n ; BuiltinType = bit_rts,\n Generate = need_extern_import\n )\n ; CodeType = ct_plasma,\n Imported = func_get_imported(Function),\n ( Imported = i_local,\n Generate = need_codegen\n ; Imported = i_imported,\n Generate = need_extern_import\n )\n )\n ; IsUsed = unused,\n Generate = dead_code\n ).\n\n:- pred assert_has_body(function::in) is det.\n\nassert_has_body(Function) :-\n ( if func_get_body(Function, _, _, _, _) then\n true\n else\n Name = q_name_to_string(func_get_name(Function)),\n unexpected($file, $pred,\n format(\"Function ('%s') has no body\",\n [s(Name)]))\n ).\n\n:- pred assert_has_no_body(function::in) is det.\n\nassert_has_no_body(Function) :-\n ( if\n not func_builtin_inline_pz(Function, _),\n not func_get_body(Function, _, _, _, _)\n then\n true\n else\n Name = q_name_to_string(func_get_name(Function)),\n unexpected($file, $pred,\n format(\"Function ('%s') doesn't have a body\",\n [s(Name)]))\n ).\n\n:- pred make_proc_id_core_or_rts(func_id::in, function::in,\n val_locn_map_static::in, val_locn_map_static::out,\n closure_builder::in, closure_builder::out, pz::in, pz::out) is det.\n\nmake_proc_id_core_or_rts(FuncId, Function, !LocnMap, !BuildModClosure, !PZ) :-\n ( if func_get_body(Function, _, _, _, _) then\n pz_new_proc_id(ProcId, !PZ),\n vls_set_proc(FuncId, ProcId, !LocnMap)\n else\n pz_new_import(ImportId,\n pz_import(func_get_name(Function), pzit_import), !PZ),\n closure_add_field(pzv_import(ImportId), FieldNum, !BuildModClosure),\n vls_set_proc_imported(FuncId, ImportId, FieldNum, !LocnMap)\n ).\n\n:- pred make_proc_id_foreign(func_id::in, function::in,\n val_locn_map_static::in, val_locn_map_static::out,\n closure_builder::in, closure_builder::out, pz::in, pz::out) is det.\n\nmake_proc_id_foreign(FuncId, Function, !LocnMap, !BuildModClosure, !PZ) :-\n pz_new_import(ImportId, pz_import(func_get_name(Function), pzit_foreign),\n !PZ),\n closure_add_field(pzv_import(ImportId), FieldNum, !BuildModClosure),\n vls_set_proc_imported(FuncId, ImportId, FieldNum, !LocnMap).\n\n%-----------------------------------------------------------------------%\n\nbool_width = data.bool_width.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/dump_stage.m", "content": "%-----------------------------------------------------------------------%\n% Dump stages utility\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% A utility predicate to dump intermediate compiler stages.\n%\n%-----------------------------------------------------------------------%\n:- module dump_stage.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module cord.\n:- import_module io.\n\n:- import_module options.\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\n:- pred maybe_dump_stage(general_options, q_name, string,\n func(D) = cord(string), D, io, io).\n:- mode maybe_dump_stage(in, in, in,\n func(in) = (out) is det, in, di, uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module list.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\nmaybe_dump_stage(GeneralOpts, ModuleName, Stage, Format, Data, !IO) :-\n DumpStages = GeneralOpts ^ go_dump_stages,\n ( DumpStages = dump_stages,\n dump_stage(GeneralOpts, Stage, ModuleName,\n append_list(list(Format(Data))), !IO)\n ; DumpStages = dont_dump_stages\n ).\n\n:- pred dump_stage(general_options::in, string::in, q_name::in, string::in,\n io::di, io::uo) is det.\n\ndump_stage(GeneralOpts, Name, ModuleName, Dump, !IO) :-\n Filename = format(\"%s/%s.plasma-dump_%s\",\n [s(GeneralOpts ^ go_dir), s(q_name_to_string(ModuleName)), s(Name)]),\n io.open_output(Filename, OpenRes, !IO),\n ( OpenRes = ok(Stream),\n io.write_string(Stream, Dump, !IO),\n io.close_output(Stream, !IO)\n ; OpenRes = error(Error),\n format(io.stderr_stream, \"%s: %s\\n\",\n [s(Filename), s(error_message(Error))], !IO),\n io.set_exit_status(1, !IO)\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/file_utils.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module file_utils.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% File handling utils specific to Plasma. These are general for the\n% different compiler tools but not general enough to go into the utils\n% package.\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module string.\n\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\n:- type dir_info.\n\n:- func init = dir_info.\n\n%-----------------------------------------------------------------------%\n\n:- type find_file_result\n ---> yes(string)\n ; no\n ; error(\n e_path :: string,\n e_error :: string\n ).\n\n % find_module_file(Path, Extension, ModuleName, Result, !DirInfo).\n %\n % Find the interface on the disk. For now we look in one directory\n % only, later we'll implement include paths.\n %\n:- pred find_module_file(string::in, string::in, q_name::in,\n find_file_result::out, dir_info::in, dir_info::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n\n % Normalises case and strips - _ and .\n %\n:- func strip_file_name_punctuation(string) = string.\n\n%-----------------------------------------------------------------------%\n\n % Return a canonical file name without an extension for the Plasma\n % module name.\n %\n:- func canonical_base_name(q_name) = string.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module char.\n:- import_module list.\n:- import_module maybe.\n:- import_module require.\n\n:- import_module constant.\n:- import_module util.\n:- import_module util.my_exception.\n:- import_module util.my_io.\n:- import_module util.path.\n\n%-----------------------------------------------------------------------%\n\n:- type dir_info == maybe(list(string)).\n\ninit = no.\n\n%-----------------------------------------------------------------------%\n\nfind_module_file(Path, Extension, ModuleName, Result, no, DirInfo, !IO) :-\n get_dir_list(Path, MaybeDirList, !IO),\n ( MaybeDirList = ok(DirInfo0),\n find_module_file(Path, Extension, ModuleName, Result,\n yes(DirInfo0), DirInfo, !IO)\n ; MaybeDirList = error(DirError),\n DirInfo = no,\n Result = error(Path, DirError)\n ).\nfind_module_file(_, Extension, ModuleName, Result, yes(DirInfo), yes(DirInfo),\n !IO) :-\n filter(matching_module_file(ModuleName, Extension), DirInfo, Matches),\n ( Matches = [],\n Result = no\n ; Matches = [FileName],\n Result = yes(FileName)\n ; Matches = [_, _ | _],\n unexpected($file, $pred, \"Ambigious files found\")\n ).\n\n:- pred matching_module_file(q_name::in, string::in, string::in) is semidet.\n\nmatching_module_file(ModuleName, Extension, FileName) :-\n filename_extension(Extension, FileName, FileNameBase),\n strip_file_name_punctuation(q_name_to_string(ModuleName)) =\n strip_file_name_punctuation(FileNameBase).\n\n%-----------------------------------------------------------------------%\n\nstrip_file_name_punctuation(Input) =\n strip_file_name_punctuation(skip_char, Input).\n\n:- func strip_file_name_punctuation(pred(char), string) = string.\n:- mode strip_file_name_punctuation(pred(in) is semidet, in) = out is det.\n\nstrip_file_name_punctuation(IsPunct, Input) = Output :-\n to_char_list(Input, InputList),\n filter_map((pred(C0::in, C::out) is semidet :-\n ( if IsPunct(C0) then\n false % Strip character\n else\n C = to_lower(C0)\n )\n ), InputList, OutputList),\n from_char_list(OutputList, Output).\n\n:- pred skip_char(char::in) is semidet.\n\nskip_char('_').\nskip_char('-').\nskip_char('.').\n\n%-----------------------------------------------------------------------%\n\n% This should work on all our filesystems, but by defining it in one place\n% we could modify it if we needed to.\ncanonical_base_name(Name) = q_name_to_string(Name).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/foreign.m", "content": "%-----------------------------------------------------------------------%\n% Plasma foreign stub generation\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module includes code for generating the code that registers foreign\n% code with the runtime system.\n%\n%-----------------------------------------------------------------------%\n:- module foreign.\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module io.\n\n:- import_module ast.\n:- import_module compile_error.\n:- import_module options.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- type foreign_info.\n\n:- func make_foreign(ast) = result(foreign_info, compile_error).\n\n:- pred write_foreign(general_options::in, string::in, foreign_info::in,\n io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module list.\n:- import_module maybe.\n:- import_module string.\n\n:- import_module compile.\n:- import_module q_name.\n:- import_module util.mercury.\n:- import_module util.my_exception.\n:- import_module util.my_io.\n\n%-----------------------------------------------------------------------%\n\n:- type foreign_info\n ---> foreign_info(\n fi_module_name :: q_name,\n fi_includes :: list(foreign_include),\n fi_funcs :: list(foreign_func)\n ).\n\n%-----------------------------------------------------------------------%\n\nmake_foreign(PlasmaAst) = MaybeForeignInfo :-\n MaybeIncludes = find_foreign_includes(PlasmaAst),\n Funcs = find_foreign_funcs(PlasmaAst),\n ( MaybeIncludes = ok(Includes),\n MaybeForeignInfo = ok(foreign_info(PlasmaAst ^ a_module_name,\n Includes, Funcs))\n ; MaybeIncludes = errors(Errors),\n MaybeForeignInfo = errors(Errors)\n ).\n\n%-----------------------------------------------------------------------%\n\nwrite_foreign(GeneralOpts, OutputHeader, ForeignInfo, !IO) :-\n WriteOutput = GeneralOpts ^ go_write_output,\n ( WriteOutput = write_output,\n OutputFile = GeneralOpts ^ go_output_file,\n write_foreign_hooks(OutputFile, OutputHeader,\n ForeignInfo ^ fi_module_name,\n ForeignInfo ^ fi_includes,\n ForeignInfo ^ fi_funcs, Result, !IO),\n ( Result = ok\n ; Result = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n )\n ; WriteOutput = dont_write_output\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type foreign_include\n ---> foreign_include(string).\n\n:- func find_foreign_includes(ast) =\n result(list(foreign_include), compile_error).\n\nfind_foreign_includes(Ast) = MaybeForeignIncludes :-\n Ast = ast(_, _, Entries),\n filter_entries(Entries, _, _, _, _, Pragmas),\n foldl_result(find_foreign_include_pragma, Pragmas,\n [], MaybeForeignIncludes0),\n MaybeForeignIncludes = result_map(reverse, MaybeForeignIncludes0).\n\n:- pred find_foreign_include_pragma(ast_pragma::in, list(foreign_include)::in,\n result(list(foreign_include), compile_error)::out) is det.\n\nfind_foreign_include_pragma(ast_pragma(Name, Args, Context),\n Includes0, MaybeIncludes) :-\n ( if Name = \"foreign_include\" then\n ( if Args = [ast_pragma_arg(String)] then\n Include = foreign_include(String),\n MaybeIncludes = ok([Include | Includes0])\n else\n MaybeIncludes = return_error(Context,\n ce_pragma_bad_argument)\n )\n else\n MaybeIncludes = ok(Includes0)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type foreign_func\n ---> foreign_func(\n ff_plasma_name :: nq_name,\n ff_foreign_name :: string\n ).\n\n:- func find_foreign_funcs(ast) = list(foreign_func).\n\nfind_foreign_funcs(Ast) = ForeignFuncs :-\n Ast = ast(_, _, Entries),\n filter_entries(Entries, _, _, _, Funcs, _),\n\n filter_map(\n (pred(nq_named(Name, Func)::in, ForeignFunc::out) is semidet :-\n Body = Func ^ af_body,\n Body = ast_body_foreign(ForeignSym),\n ForeignFunc = foreign_func(Name, ForeignSym)\n ),\n Funcs, ForeignFuncs).\n\n%-----------------------------------------------------------------------%\n\n:- pred write_foreign_hooks(string::in, string::in, q_name::in,\n list(foreign_include)::in, list(foreign_func)::in, maybe_error::out,\n io::di, io::uo) is det.\n\nwrite_foreign_hooks(FilenameCode, FilenameHeader, ModuleName,\n ForeignIncludes, ForeignFuncs, Result, !IO) :-\n write_temp(open_output, close_output,\n write_foreign_hooks_code(ModuleName, ForeignIncludes, ForeignFuncs),\n FilenameCode, ResultCode, !IO),\n write_temp(open_output, close_output,\n write_foreign_hooks_header(ModuleName),\n FilenameHeader, ResultHeader, !IO),\n move_temps_if_successful([ResultCode, ResultHeader], Result, !IO).\n\n:- pred write_foreign_hooks_code(q_name::in, list(foreign_include)::in,\n list(foreign_func)::in, output_stream::in, maybe_error::out,\n io::di, io::uo) is det.\n\nwrite_foreign_hooks_code(ModuleName, ForeignIncludes, ForeignFuncs, File,\n ok, !IO) :-\n format(File, \"// Foreign hooks for %s\\n\\n\",\n [s(q_name_to_string(ModuleName))], !IO),\n\n % XXX Fix include path.\n write_string(File, \"#include \\\"../../../runtime/pz_common.h\\\"\\n\", !IO),\n write_string(File, \"#include \\\"../../../runtime/pz_foreign.h\\\"\\n\", !IO),\n write_string(File, \"#include \\\"../../../runtime/pz_generic_run.h\\\"\\n\\n\", !IO),\n foldl(write_include(File), ForeignIncludes, !IO),\n nl(File, !IO),\n\n write_string(File, \"using namespace pz;\\n\\n\", !IO),\n\n format(File, \"bool pz_init_foreign_code_%s(void *f_, void *gc_) {\\n\",\n [s(q_name_clobber(ModuleName))], !IO),\n write_string(File,\n \" GCTracer &gc = *reinterpret_cast(gc_);\\n\", !IO),\n write_string(File,\n \" Foreign *f = reinterpret_cast(f_);\\n\", !IO),\n\n foldl(write_register_foreign_func(File, ModuleName), ForeignFuncs, !IO),\n write_string(File, \" return true;\\n\", !IO),\n write_string(File, \"}\\n\", !IO).\n\n:- pred write_foreign_hooks_header(q_name::in, output_stream::in,\n maybe_error::out, io::di, io::uo) is det.\n\nwrite_foreign_hooks_header(ModuleName, File, ok, !IO) :-\n format(File, \"// Foreign hooks for %s\\n\\n\",\n [s(q_name_to_string(ModuleName))], !IO),\n\n format(File, \"bool pz_init_foreign_code_%s(void *f, void *gc);\\n\",\n [s(q_name_clobber(ModuleName))], !IO),\n nl(File, !IO).\n\n:- pred write_include(output_stream::in, foreign_include::in,\n io::di, io::uo) is det.\n\nwrite_include(File, foreign_include(Path), !IO) :-\n io.format(File, \"#include \\\"../%s\\\"\\n\", [s(Path)], !IO).\n\n:- pred write_register_foreign_func(output_stream::in, q_name::in,\n foreign_func::in, io::di, io::uo) is det.\n\nwrite_register_foreign_func(File, ModuleName,\n foreign_func(FuncName, ForeignSym), !IO) :-\n format(File, \" if (!f->register_foreign_code(String(\\\"%s\\\"), String(\\\"%s\\\"), %s, gc)) {\\n\",\n [s(q_name_to_string(ModuleName)), s(nq_name_to_string(FuncName)),\n s(ForeignSym)],\n !IO),\n write_string(File, \" return false;\\n\", !IO),\n write_string(File, \" }\\n\", !IO).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/lex.automata.m", "content": "%-----------------------------------------------------------------------------%\n% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix\n%-----------------------------------------------------------------------------%\n% lex.automata.m\n% Copyright (C) 2001 Ralph Becket \n% Copyright (C) 2002, 2010 The University of Melbourne\n%\n% This file may only be copied under the terms of the GNU Library General\n% Public License - see the file COPYING.LIB in the Mercury distribution.\n%\n% Fri Aug 18 15:48:09 BST 2000\n% \n% Basic types and insts etc. for DFAs and NFAs over chars.\n%\n% THIS FILE IS HEREBY CONTRIBUTED TO THE MERCURY PROJECT TO\n% BE RELEASED UNDER WHATEVER LICENCE IS DEEMED APPROPRIATE\n% BY THE ADMINISTRATORS OF THE MERCURY PROJECT.\n%\n%-----------------------------------------------------------------------------%\n\n:- module lex.automata.\n:- interface.\n\n:- import_module list.\n:- import_module set.\n\n%-----------------------------------------------------------------------------%\n \n % States are labelled with non-negative integers.\n %\n:- type state_no == int.\n\n:- type state_mc\n ---> state_mc(\n smc_start_state :: state_no,\n smc_stop_states :: set(state_no),\n smc_state_transitions :: list(transition)\n ).\n\n:- inst null_transition_free_state_mc\n == bound(state_mc(ground, ground, atom_transitions)).\n\n:- type transitions == list(transition).\n\n:- inst atom_transitions == list_skel(atom_transition).\n:- inst null_transitions == list_skel(null_transition).\n\n:- type transition\n ---> null(state_no, state_no)\n ; trans(state_no, charset, state_no).\n\n:- inst atom_transition == bound(trans(ground, ground, ground)).\n:- inst null_transition == bound(null(ground, ground)).\n\n%-----------------------------------------------------------------------------%\n:- end_module lex.automata.\n%-----------------------------------------------------------------------------%\n" }, { "path": "src/lex.buf.m", "content": "%-----------------------------------------------------------------------------%\n% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix\n%-----------------------------------------------------------------------------%\n% lex.buf.m\n% Copyright (C) 2001 Ralph Becket \n% Copyright (C) 2002, 2010 The University of Melbourne\n%\n% This file may only be copied under the terms of the GNU Library General\n% Public License - see the file COPYING.LIB in the Mercury distribution.\n%\n% Sat Aug 19 16:56:30 BST 2000\n%\n% This module implements the rolling char buffer. The char\n% buffer is optimised for efficiency.\n%\n% The buffer stores chars read from an input source (e.g. IO\n% or string). Because the lexer can want to `unread' chars\n% (when a long candidate lexeme fails), the buffer may\n% contain `read ahead' chars. The structure of the buffer\n% is as follows:\n%\n% buf[0] buf[len]\n% | len = end - start |\n% v v\n% +---------------------------------------------------+\n% |.|.|.|.|.|a|b|c|d|e|f|g|h|i|j|k|l| | | | | | | | | |\n% +---------------------------------------------------+\n% ^ ^ ^ ^ ^ \n% | | | | |\n% origin start cursor end terminus\n%\n% origin, start etc. are all recorded in terms of offsets\n% (number of chars) from the start of the input stream,\n% counting the first char read as being at offset 1. Hence,\n% the char at the cursor is at buf[cursor - origin].\n%\n% READING CHARS\n%\n% * In the diagram, `g' is the next char that will be read.\n%\n% Thu cursor marks the point of the next char to be read in.\n%\n% If the cursor advances to the end, then a new char is read\n% from the input and inserted into the buffer at the end and\n% the end marker is incremented.\n%\n% If the end marker advances to the terminus, then the\n% buffer is extended and the terminus adjusted\n% appropriately. The buffer may take this opportunity to\n% garbage collect the inaccessible chars between the origin\n% and the start marker.\n%\n% EOF\n%\n% * In the diagram, if EOF had been detected then the end\n% marker would give the offset at which it occurred.\n%\n% When EOF is read from the input stream, a special eof flag\n% is set (and the end marker, of course, will give its offset).\n% Any attempt to read at or past this point will cause the\n% buffer to return the EOF signal.\n%\n% REWINDING\n%\n% * In the diagram, the cursor may be rewound to any point\n% between the start marker and itself, inclusive.\n%\n% At any point, the cursor may be reset to any point between\n% itself and the start marker inclusive.\n%\n%\n% At any point, the user may ask for the offset of the cursor.\n%\n% STRING EXTRACTION\n%\n% * In the diagram, the string read in so far is \"abcdef\".\n%\n% The buffer provides a facility to return the substring\n% consisting of the chars between the start marker and up\n% to, but not including, that under the cursor.\n%\n% COMMITS\n%\n% * In the diagram, a commit will move the start marker to\n% be the same as the cursor.\n%\n% The user can issue a commit order to the buffer which\n% moves the start pointer to where the cursor is, preventing\n% rewinds back past this point. This is important since it\n% means that the region prior to the cursor in the buffer is\n% now available for garbage collection.\n%\n%-----------------------------------------------------------------------------%\n\n:- module lex.buf.\n:- interface.\n\n:- import_module array.\n:- import_module bool.\n:- import_module char.\n:- import_module string.\n\n%-----------------------------------------------------------------------------%\n\n % XXX We need a char and/or byte array datatype;\n % array(char) uses one word for each char, which is\n % rather wasteful.\n %\n:- type buf\n == array(char).\n\n % T is the type of the input source (typically io.state or string);\n % the user must initialise the buffer by specifying an appropriate\n % read predicate.\n %\n:- type buf_state(T)\n ---> buf_state(\n buf_origin :: offset,\n buf_start :: offset,\n buf_cursor :: offset,\n buf_end :: offset,\n buf_terminus :: offset,\n buf_eof_seen :: bool, % If `yes' then buf_end\n % has the offset\n buf_read_pred :: read_pred(T)\n ).\n:- inst buf_state\n == bound(buf_state(ground, ground, ground, ground, ground, ground,\n read_pred)).\n\n\n\n % Returns an empty buffer and an initialised buf_state.\n %\n:- pred init(read_pred(T), buf_state(T), buf).\n:- mode init(in(read_pred), out(buf_state), array_uo) is det.\n\n % Reads the next char and advances the cursor. Updates the\n % buf_state, the buf and the input.\n %\n:- pred read(read_result, buf_state(T), buf_state(T), buf, buf, T, T).\n:- mode read(out, in(buf_state), out(buf_state), array_di, array_uo,\n di, uo) is det.\n\n % Returns the offset of the start marker.\n %\n:- func start_offset(buf_state(T)) = offset.\n:- mode start_offset(in(buf_state)) = out is det.\n\n % Returns the offset of the cursor.\n %\n:- func cursor_offset(buf_state(T)) = offset.\n:- mode cursor_offset(in(buf_state)) = out is det.\n\n % Rewinds the buffer. An exception is raised if the offset provided\n % is not legitimate.\n %\n:- func rewind_cursor(offset, buf_state(T)) = buf_state(T).\n:- mode rewind_cursor(in, in(buf_state)) = out(buf_state) is det.\n\n % Extracts the string of chars between the start and cursor.\n %\n:- func string_to_cursor(buf_state(T), buf) = string.\n:- mode string_to_cursor(in(buf_state), array_ui) = out is det.\n\n % Advances the start marker to the cursor. Rewinds past the\n % cursor will therefore no longer be possible.\n %\n:- func commit(buf_state(T)) = buf_state(T).\n:- mode commit(in(buf_state)) = out(buf_state) is det.\n\n%-----------------------------------------------------------------------------%\n%-----------------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module exception.\n\n\n % The amount the buffer is grown by if (a) more space is\n % required and (b) the available space is smaller than\n % this amount.\n %\n:- func low_water_mark = int.\nlow_water_mark = 256.\n\n:- func initial_buf_size = int.\ninitial_buf_size = 1024.\n\n % XXX Debugging values.\n % %\n% :- func low_water_mark = int.\n% low_water_mark = 16.\n% \n% :- func initial_buf_size = int.\n% initial_buf_size = 32.\n\n%-----------------------------------------------------------------------------%\n\ninit(BufReadPred, BufState, Buf) :-\n BufState = buf_state(0, 0, 0, 0, initial_buf_size, no, BufReadPred),\n Buf = array.init(initial_buf_size, ('@')).\n\n%-----------------------------------------------------------------------------%\n\nread(Result, BufState0, BufState, Buf0, Buf, Src0, Src) :-\n\n Origin = BufState0 ^ buf_origin,\n Start = BufState0 ^ buf_start,\n Cursor = BufState0 ^ buf_cursor,\n End = BufState0 ^ buf_end,\n Terminus = BufState0 ^ buf_terminus,\n EOFSeen = BufState0 ^ buf_eof_seen,\n ReadP = BufState0 ^ buf_read_pred,\n\n ( if Cursor < End then\n\n Result = ok(array.lookup(Buf0, Cursor - Origin)),\n BufState = ( BufState0 ^ buf_cursor := Cursor + 1 ),\n Buf = Buf0,\n Src = Src0\n\n else /* Cursor = End */ if EOFSeen = yes then\n\n Result = eof,\n BufState = BufState0,\n Buf = Buf0,\n Src = Src0\n\n else if End < Terminus then\n\n ReadP(Cursor, Result, Src0, Src),\n\n ( if Result = ok(Char) then\n\n Buf = array.set(Buf0, End - Origin, Char),\n BufState = (( BufState0\n ^ buf_cursor := Cursor + 1 )\n ^ buf_end := End + 1 )\n else\n\n Buf = Buf0,\n BufState = BufState0\n )\n\n else /* Need to GC and/or extend the buffer */\n\n GarbageLength = Start - Origin,\n adjust_buf(GarbageLength, ExtraLength, Buf0, Buf1),\n NewOrigin = Origin + GarbageLength,\n NewTerminus = Terminus + GarbageLength + ExtraLength,\n BufState1 = (( BufState0\n ^ buf_origin := NewOrigin )\n ^ buf_terminus := NewTerminus ),\n read(Result, BufState1, BufState, Buf1, Buf, Src0, Src)\n ).\n\n%-----------------------------------------------------------------------------%\n\n % Garbage collects the chars between the origin and start and\n % extends the buffer if the remaining space is below the low\n % water mark.\n %\n:- pred adjust_buf(int, int, buf, buf).\n:- mode adjust_buf(in, out, array_di, array_uo) is det.\n\nadjust_buf(GarbageLength, ExtraLength, Buf0, Buf) :-\n\n Size0 = array.size(Buf0),\n\n ( if GarbageLength < low_water_mark then /* We need to grow the buffer */\n array.init(Size0 + low_water_mark, ('@'), Buf1),\n ExtraLength = low_water_mark\n else\n Buf1 = Buf0,\n ExtraLength = 0\n ),\n\n Buf = shift_buf(0, Size0 - GarbageLength, GarbageLength, Buf0, Buf1).\n\n%-----------------------------------------------------------------------------%\n\n:- func shift_buf(int, int, int, buf, buf) = buf.\n:- mode shift_buf(in, in, in, array_ui, array_di) = array_uo is det.\n\nshift_buf(I, Hi, Disp, Src, Tgt) =\n ( if I < Hi then\n shift_buf(I + 1, Hi, Disp, Src,\n array.set(Tgt, I, array.lookup(Src, I + Disp)))\n else\n Tgt\n ).\n\n%-----------------------------------------------------------------------------%\n\nstart_offset(BufState) = BufState ^ buf_start.\n\n%-----------------------------------------------------------------------------%\n\ncursor_offset(BufState) = BufState ^ buf_cursor.\n\n%-----------------------------------------------------------------------------%\n\nrewind_cursor(Offset, BufState) =\n ( if ( Offset < BufState ^ buf_start ; BufState ^ buf_cursor < Offset )\n then throw(\"buf: rewind/2: offset arg outside valid range\")\n else BufState ^ buf_cursor := Offset\n ).\n\n%-----------------------------------------------------------------------------%\n\nstring_to_cursor(BufState, Buf) = String :-\n From = BufState ^ buf_start - BufState ^ buf_origin,\n Length = (BufState ^ buf_cursor - 1 - BufState ^ buf_start),\n To = From + Length,\n String = string.from_char_list(array.fetch_items(Buf, From, To)).\n\n%-----------------------------------------------------------------------------%\n\ncommit(BufState) = ( BufState ^ buf_start := BufState ^ buf_cursor ).\n\n%-----------------------------------------------------------------------------%\n:- end_module lex.buf.\n%-----------------------------------------------------------------------------%\n" }, { "path": "src/lex.convert_NFA_to_DFA.m", "content": "%----------------------------------------------------------------------------\n% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix\n%----------------------------------------------------------------------------\n%\n% lex.convert_NFA_to_DFA.m\n% Copyright (C) 2001 Ralph Becket \n% Copyright (C) 2002, 2010 The University of Melbourne\n% Copyright (C) 2020 Plasma Team\n%\n% This file may only be copied under the terms of the GNU Library General\n% Public License - see the file COPYING.LIB in the Mercury distribution.\n%\n% Fri Aug 18 12:30:25 BST 2000\n%\n% Powerset construction used to transform NFAs into DFAs.\n%\n%-----------------------------------------------------------------------------%\n\n:- module lex.convert_NFA_to_DFA.\n:- interface.\n\n:- import_module lex.automata.\n\n:- func convert_NFA_to_DFA(state_mc) = state_mc.\n:- mode convert_NFA_to_DFA(in(null_transition_free_state_mc)) =\n out(null_transition_free_state_mc) is det.\n\n%-----------------------------------------------------------------------------%\n%-----------------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module char.\n:- import_module counter.\n:- import_module int.\n:- import_module list.\n:- import_module map.\n:- import_module set.\n:- import_module sparse_bitset.\n\n%-----------------------------------------------------------------------------%\n\n:- type state_sets\n == set(state_set).\n\n:- type state_set\n == set(state_no).\n\n:- type state_set_transitions\n == list(state_set_transition).\n\n:- type state_set_transition\n ---> trans(state_set, charset, state_set).\n\n:- type state_set_no_map\n == map(state_set, int).\n\n%-----------------------------------------------------------------------------%\n\nconvert_NFA_to_DFA(NFA) = NFA :-\n\n % An NFA with no transitions is probably a bug...\n\n NFA ^ smc_state_transitions = [].\n\nconvert_NFA_to_DFA(NFA) = DFA :-\n\n NFA ^ smc_state_transitions = [_ | _],\n\n % Do some unpacking of the NFA.\n %\n NFAStopStates = NFA ^ smc_stop_states,\n NFATransitions = NFA ^ smc_state_transitions,\n DFAStartStateSet = set.make_singleton_set(NFA ^ smc_start_state),\n DFAStartStateSets = set.make_singleton_set(DFAStartStateSet),\n\n % Calculate the powerset version of the DFA from the NFA.\n %\n compute_DFA_state_sets_and_transitions(\n NFATransitions, DFAStartStateSets,\n DFAStartStateSets, DFAStateSets,\n [], DFAStateSetTransitions\n ),\n DFAStopStateSets = compute_DFA_stop_state_sets(NFAStopStates, DFAStateSets),\n\n % Replace the powerset state_no identifiers with numbers.\n %\n DFAStateNos = number_state_sets(DFAStateSets),\n map.lookup(DFAStateNos, DFAStartStateSet, DFAStartState),\n DFAStopStates = set.map(map.lookup(DFAStateNos), DFAStopStateSets),\n DFATransitions = map_state_set_transitions_to_numbers(\n DFAStateNos,\n DFAStateSetTransitions\n ),\n\n % Pack up the result.\n %\n DFA = state_mc(DFAStartState, DFAStopStates, DFATransitions).\n\n%-----------------------------------------------------------------------------%\n\n % If S is a state_no set, then S -c-> S' where\n % S' = {y | x in S, x -c-> y}\n %\n % We iterate to the least fixed point starting with the start\n % state_no set.\n %\n:- pred compute_DFA_state_sets_and_transitions(\n transitions, state_sets,\n state_sets, state_sets,\n state_set_transitions, state_set_transitions).\n:- mode compute_DFA_state_sets_and_transitions(in, in, in, out, in, out) is det.\n\ncompute_DFA_state_sets_and_transitions(Ts, NewSs0, Ss0, Ss, STs0, STs) :-\n\n ( if set.is_empty(NewSs0) then\n\n Ss = Ss0,\n STs0 = STs\n\n else\n\n NewSTs =\n list.condense(\n list.map(state_set_transitions(Ts),set.to_sorted_list(NewSs0))\n ),\n STs1 = list.append(NewSTs, STs0),\n\n TargetSs =\n set.list_to_set(\n list.map(( func(trans(_, _, S)) = S ), NewSTs)\n ),\n NewSs = TargetSs `set.difference` Ss0,\n Ss1 = NewSs `set.union` Ss0,\n\n compute_DFA_state_sets_and_transitions(Ts, NewSs, Ss1, Ss, STs1, STs)\n ).\n\n%-----------------------------------------------------------------------------%\n\n % Given a state_no set and a set of transition chars for that\n % state_no set, find the set of state_no set transitions (said\n % Peter Piper):\n %\n % state_set_transitions(S) = {S -c-> S' | x in S, S' = {y | x -c-> y}}\n %\n:- func state_set_transitions(transitions, state_set) = state_set_transitions.\n\nstate_set_transitions(Ts, S) = STs :-\n TCs = to_sorted_list(transition_chars(Ts, S)),\n STs = list.map(state_set_transition(Ts, S), TCs).\n\n%-----------------------------------------------------------------------------%\n\n % Given a state_no set, find all the transition chars:\n %\n % transition_chars(S) = {c | x in S, some [y] x -c-> y}\n %\n:- func transition_chars(transitions, state_set) = charset.\n\ntransition_chars(Ts, S) = Charset :-\n Sets = list.map(transition_chars_for_state(Ts), set.to_sorted_list(S)),\n Charset = union_list(Sets).\n\n%-----------------------------------------------------------------------------%\n\n:- func transition_chars_for_state(transitions, state_no) = charset.\n:- mode transition_chars_for_state(in, in) = out is det.\n\ntransition_chars_for_state(Ts, X) =\n union_list(list.filter_map(transition_char_for_state(X), Ts)).\n\n%-----------------------------------------------------------------------------%\n\n:- func transition_char_for_state(state_no, transition) = charset.\n:- mode transition_char_for_state(in, in) = out is semidet.\n\ntransition_char_for_state(X, trans(X, C, _Y)) = C.\n\n%-----------------------------------------------------------------------------%\n\n % Given a state_no set and a char, find the state_no set transition:\n %\n % state_set_transition(S, c) = S -c-> target_state_set(S, c)\n %\n:- func state_set_transition(transitions, state_set, char) =\n state_set_transition.\n\nstate_set_transition(Ts, FromStateSet, C) =\n trans(FromStateSet, Charset, TargetStateSet) :-\n Charset = sparse_bitset.make_singleton_set(C),\n TargetStateSet = target_state_set(Ts, FromStateSet, C).\n\n%-----------------------------------------------------------------------------%\n\n % Given a state_no set and a char, find the target state_no set:\n %\n % target_state_set(S, c) = {y | x in S, x -c-> y}\n %\n:- func target_state_set(transitions, state_set, char) = state_set.\n\ntarget_state_set(Ts, S, C) =\n set.power_union(set.map(target_state_set_0(Ts, C), S)).\n\n%-----------------------------------------------------------------------------%\n\n:- func target_state_set_0(transitions, char, state_no) = state_set.\n\ntarget_state_set_0(Ts, C, X) =\n set.list_to_set(list.filter_map(target_state(X, C), Ts)).\n\n%-----------------------------------------------------------------------------%\n\n:- func target_state(state_no, char, transition) = state_no.\n:- mode target_state(in, in, in) = out is semidet.\n\ntarget_state(X, C, trans(X, Charset, Y)) = Y :-\n contains(Charset, C).\n\n%-----------------------------------------------------------------------------%\n\n:- func compute_DFA_stop_state_sets(state_set, state_sets) = state_sets.\n\ncompute_DFA_stop_state_sets(StopStates, StateSets) =\n set.filter_map(stop_state_set(StopStates), StateSets).\n\n%-----------------------------------------------------------------------------%\n\n:- func stop_state_set(state_set, state_set) = state_set.\n:- mode stop_state_set(in, in) = out is semidet.\n\nstop_state_set(StopStates, StateSet) = StateSet :-\n not set.is_empty(StopStates `set.intersect` StateSet).\n\n%-----------------------------------------------------------------------------%\n\n:- func number_state_sets(state_sets) = state_set_no_map.\n\nnumber_state_sets(Ss) = StateNos :-\n list.foldl2(\n ( pred(S::in, N::in, (N + 1)::out, Map0::in, Map::out) is det :-\n Map = map.set(Map0, S, N)\n ),\n set.to_sorted_list(Ss),\n 0, _,\n map.init, StateNos\n ).\n\n%-----------------------------------------------------------------------------%\n\n:- func map_state_set_transitions_to_numbers(state_set_no_map::in,\n state_set_transitions::in) = (transitions::out(atom_transitions)).\n\nmap_state_set_transitions_to_numbers(_Map, []) = [].\nmap_state_set_transitions_to_numbers(Map, [ST | STs]) = [T | Ts] :-\n Ts = map_state_set_transitions_to_numbers(Map, STs),\n ST = trans(SX, C, SY),\n X = map.lookup(Map, SX),\n Y = map.lookup(Map, SY),\n T = trans(X, C ,Y).\n\n%-----------------------------------------------------------------------------%\n:- end_module lex.convert_NFA_to_DFA.\n%-----------------------------------------------------------------------------%\n" }, { "path": "src/lex.lexeme.m", "content": "%----------------------------------------------------------------------------\n% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix\n%\n%\n% lex.lexeme.m\n% Sat Aug 19 08:22:32 BST 2000\n% Copyright (C) 2001 Ralph Becket \n% Copyright (C) 2001 The Rationalizer Intelligent Software AG\n% The changes made by Rationalizer are contributed under the terms \n% of the GNU Lesser General Public License, see the file COPYING.LGPL\n% in this directory.\n% Copyright (C) 2002, 2010-2011 The University of Melbourne\n%\n% This file may only be copied under the terms of the GNU Library General\n% Public License - see the file COPYING.LIB in the Mercury distribution.\n%\n% A lexeme combines a token with a regexp. The lexer compiles\n% lexemes and returns the longest successful parse in the input\n% stream or an error if no match occurs.\n%\n%-----------------------------------------------------------------------------%\n\n:- module lex.lexeme.\n:- interface.\n\n:- import_module array.\n:- import_module bool.\n:- import_module bitmap.\n:- import_module char.\n\n%-----------------------------------------------------------------------------%\n\n:- type compiled_lexeme(T)\n ---> compiled_lexeme(\n token :: token_creator(T),\n state :: state_no,\n transition_map :: transition_map\n ).\n\n:- inst compiled_lexeme\n ---> compiled_lexeme(token_creator, ground, ground).\n\n:- type transition_map\n ---> transition_map(\n accepting_states :: bitmap,\n rows :: array(row)\n ).\n\n % A transition row is an array of packed_transitions.\n %\n:- type row == array(packed_transition).\n\n % A packed_transition combines a target state_no \n % and the transition char codepoint for which the\n % transition is valid.\n %\n:- type packed_transition\n ---> packed_transition(btr_state :: state_no, char :: char).\n\n:- type packed_transitions \n == list(packed_transition).\n\n:- func compile_lexeme(lexeme(T)) = compiled_lexeme(T).\n\n % next_state(CLXM, CurrentState, Char, NextState, IsAccepting)\n % succeeds iff there is a transition in CLXM from CurrentState\n % to NextState via Char; IsAccepting is `yes' iff NextState is\n % an accepting state_no.\n %\n:- pred next_state(compiled_lexeme(T), state_no, char, state_no, bool).\n:- mode next_state(in(compiled_lexeme), in, in, out, out) is semidet.\n\n % Succeeds iff a compiled_lexeme is in an accepting state_no.\n %\n:- pred in_accepting_state(compiled_lexeme(T)).\n:- mode in_accepting_state(in(compiled_lexeme)) is semidet.\n\n%-----------------------------------------------------------------------------%\n%-----------------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module lex.automata.\n:- import_module lex.regexp.\n:- import_module lex.convert_NFA_to_DFA.\n\n:- import_module list.\n:- import_module set.\n\n%-----------------------------------------------------------------------------%\n\ncompile_lexeme(Lexeme) = CompiledLexeme :-\n Lexeme = (RegExp - TokenCreator),\n NFA = remove_null_transitions(regexp_to_NFA(RegExp)),\n DFA = convert_NFA_to_DFA(NFA),\n StartState = DFA ^ smc_start_state,\n StopStates = DFA ^ smc_stop_states,\n Transitions = DFA ^ smc_state_transitions,\n N = 1 + find_top_state(Transitions),\n Accepting = set_accepting_states(StopStates, bitmap.init(N, no)),\n Rows = array(set_up_rows(0, N, Transitions)),\n TransitionMap = transition_map(Accepting, Rows),\n CompiledLexeme = compiled_lexeme(TokenCreator, StartState, TransitionMap).\n\n%-----------------------------------------------------------------------------%\n\n:- func find_top_state(transitions) = int.\n:- mode find_top_state(in(atom_transitions)) = out is det.\n\nfind_top_state([]) = 0.\nfind_top_state([trans(X, _, Y) | Ts]) = max(X, max(Y, find_top_state(Ts))).\n\n%-----------------------------------------------------------------------------%\n\n:- func set_accepting_states(set(state_no), bitmap) = bitmap.\n:- mode set_accepting_states(in, bitmap_di) = bitmap_uo is det.\n\nset_accepting_states(States, Bitmap0) =\n set_accepting_states_0(set.to_sorted_list(States), Bitmap0).\n\n:- func set_accepting_states_0(list(state_no), bitmap) = bitmap.\n:- mode set_accepting_states_0(in, bitmap_di) = bitmap_uo is det.\n\nset_accepting_states_0([], Bitmap) = Bitmap.\n\nset_accepting_states_0([St | States], Bitmap) =\n set_accepting_states_0(States, bitmap.set(Bitmap, St)).\n\n%-----------------------------------------------------------------------------%\n\n:- func set_up_rows(int, int, transitions) = list(row).\n:- mode set_up_rows(in, in, in(atom_transitions)) = out is det.\n\nset_up_rows(I, N, Transitions) = Rows :-\n ( if I >= N\n then Rows = []\n else Rows = [compile_transitions_for_state(I, [], Transitions) |\n set_up_rows(I + 1, N, Transitions)]\n ).\n\n%-----------------------------------------------------------------------------%\n\n:- func compile_transitions_for_state(int, packed_transitions, transitions) =\n row.\n:- mode compile_transitions_for_state(in, in, in(atom_transitions)) =\n array_uo is det.\n\ncompile_transitions_for_state(_, IBTs, []) = array(IBTs).\n\ncompile_transitions_for_state(I, IBTs, [T | Ts]) =\n compile_transitions_for_state(\n I,\n ( if T = trans(I, Charset, Y)\n then sparse_bitset.foldl(\n func(Char, Tx) = [packed_transition(Y, Char) | Tx],\n Charset,\n IBTs)\n else IBTs\n ),\n Ts\n ).\n\n%-----------------------------------------------------------------------------%\n\nnext_state(CLXM, CurrentState, Char, NextState, IsAccepting) :-\n Rows = CLXM ^ transition_map ^ rows,\n AcceptingStates = CLXM ^ transition_map ^ accepting_states,\n find_next_state(Char, Rows ^ elem(CurrentState), NextState),\n IsAccepting = AcceptingStates ^ bit(NextState).\n\n%-----------------------------------------------------------------------------%\n\n:- pred find_next_state(char, array(packed_transition), state_no).\n:- mode find_next_state(in, in, out) is semidet.\n\nfind_next_state(Char, PackedTransitions, State) :-\n Lo = array.min(PackedTransitions),\n Hi = array.max(PackedTransitions),\n find_next_state_0(Lo, Hi, Char, PackedTransitions, State).\n\n:- pred find_next_state_0(int, int, char, array(packed_transition), state_no).\n:- mode find_next_state_0(in, in, in, in, out) is semidet.\n\nfind_next_state_0(Lo, Hi, Char, PackedTransitions, State) :-\n Lo =< Hi,\n PackedTransition = PackedTransitions ^ elem(Lo),\n ( if PackedTransition ^ char = Char\n then State = PackedTransition ^ btr_state\n else find_next_state_0(Lo + 1, Hi, Char, PackedTransitions, State)\n ).\n\n%-----------------------------------------------------------------------------%\n\nin_accepting_state(CLXM) :-\n bitmap.is_set(\n CLXM ^ transition_map ^ accepting_states, CLXM ^ state\n ).\n\n%-----------------------------------------------------------------------------%\n:- end_module lex.lexeme.\n%-----------------------------------------------------------------------------%\n" }, { "path": "src/lex.m", "content": "%-----------------------------------------------------------------------------%\n% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix\n%-----------------------------------------------------------------------------%\n%\n% lex.m\n% Copyright (C) 2001-2002 Ralph Becket \n% Sun Aug 20 09:08:46 BST 2000\n% Copyright (C) 2001-2002 The Rationalizer Intelligent Software AG\n% The changes made by Rationalizer are contributed under the terms\n% of the GNU Lesser General Public License, see the file COPYING.LGPL\n% in this directory.\n% Copyright (C) 2002, 2006, 2010-2011 The University of Melbourne\n%\n% This file may only be copied under the terms of the GNU Library General\n% Public License - see the file COPYING.LIB in the Mercury distribution.\n%\n% This module puts everything together, compiling a list of lexemes\n% into state machines and turning the input stream into a token stream.\n%\n% Note that the astral charaters (in unicode) are not included in the range\n% of unicode characters, as the astral planes are very sparsely assigned.\n%\n%-----------------------------------------------------------------------------%\n\n:- module lex.\n:- interface.\n\n:- import_module char.\n:- import_module io.\n:- import_module list.\n:- import_module pair.\n:- import_module string.\n:- import_module sparse_bitset.\n:- import_module enum.\n\n%-----------------------------------------------------------------------------%\n\n:- type token_creator(Token)\n == (func(string) = Token).\n:- inst token_creator\n == (func(in) = out is det).\n\n:- type lexeme(Token)\n == pair(regexp, token_creator(Token)).\n\n:- inst lexeme(Inst)\n ---> (ground - Inst).\n\n:- type lexer(Token, Source).\n\n:- type lexer_state(Token, Source).\n\n:- type offset\n == int. % Byte offset into the source data.\n\n % Any errors should be reported by raising an exception.\n %\n:- type read_result\n ---> ok(char)\n ; eof.\n\n % read_pred(Offset, Result, SrcIn, SrcOut) reads the char at\n % Offset from SrcIn and returns SrcOut.\n %\n:- type read_pred(T)\n == pred(offset, read_result, T, T).\n:- inst read_pred\n == ( pred(in, out, di, uo) is det ).\n\n % ignore_pred(Token): if it does not fail, Token must be ignored\n %\n:- type ignore_pred(Tok)\n == pred(Tok).\n:- inst ignore_pred\n == ( pred(in) is semidet ).\n\n % Represents a set of Unicode characters\n %\n:- type charset\n == sparse_bitset(char).\n\n % The type of regular expressions.\n %\n:- type regexp.\n\n % The typeclass for types having a natural converter to regexp's\n %\n:- typeclass regexp(T) where [\n func re(T) = regexp\n].\n\n % Handling regexp's based on the typeclass regexp(T)\n %\n:- func null = regexp.\n:- func T1 ++ T2 = regexp <= (regexp(T1), regexp(T2)).\n:- func *(T) = regexp <= (regexp(T)).\n % One of the following two functions may be deprecated\n % in future, depending upon whether there's a concensus\n % concerning which is preferable. Both express\n % alternation.\n %\n:- func T1 \\/ T2 = regexp <= (regexp(T1), regexp(T2)).\n:- func (T1 or T2) = regexp <= (regexp(T1), regexp(T2)).\n\n % Some instances of typeclass regexp(T)\n %\n:- instance regexp(regexp).\n:- instance regexp(char).\n:- instance regexp(string).\n:- instance regexp(sparse_bitset(T)) <= (regexp(T),enum(T)).\n\n % Some basic non-primitive regexps.\n %\n:- func any(string) = regexp. % any(\"abc\") = ('a') or ('b') or ('c')\n:- func anybut(string) = regexp. % anybut(\"abc\") is complement of any(\"abc\")\n:- func ?(T) = regexp <= regexp(T). % ?(R) = R or null\n:- func +(T) = regexp <= regexp(T). % +(R) = R ++ *(R)\n:- func range(char, char) = regexp. % range('a', 'z') = any(\"ab...xyz\")\n:- func (T * int) = regexp <= regexp(T). % R * N = R ++ ... ++ R\n\n % Some useful single-char regexps.\n %\n:- func digit = regexp. % digit = any(\"0123456789\")\n:- func lower = regexp. % lower = any(\"abc...z\")\n:- func upper = regexp. % upper = any(\"ABC...Z\")\n:- func alpha = regexp. % alpha = lower or upper\n:- func alphanum = regexp. % alphanum = alpha or digit\n:- func identstart = regexp. % identstart = alpha or \"_\"\n:- func ident = regexp. % ident = alphanum or \"_\"\n:- func tab = regexp. % tab = re(\"\\t\")\n:- func spc = regexp. % spc = re(\" \")\n:- func wspc = regexp. % wspc = any(\" \\t\\n\\r\\f\\v\")\n:- func dot = regexp. % dot = anybut(\"\\r\\n\")\n\n % Some useful compound regexps.\n %\n:- func nl = regexp. % nl = ?(\"\\r\") ++ re(\"\\n\")\n:- func nat = regexp. % nat = +(digit)\n:- func signed_int = regexp. % signed_int = ?(\"+\" or \"-\") ++ nat\n:- func real = regexp. % real = \\d+((.\\d+([eE]int)?)|[eE]int)\n:- func identifier = regexp. % identifier = identstart ++ *(ident)\n:- func whitespace = regexp. % whitespace = +(wspc)\n:- func junk = regexp. % junk = +(dot)\n\n % A range of charicters, inclusive of both the first and last values.\n %\n:- type char_range\n ---> char_range(\n cr_first :: int,\n cr_last :: int\n ).\n\n % charset(Start, End) = charset(Start `..` End)\n %\n % Throws an exception if Start > End.\n %\n:- func charset(int, int) = charset.\n\n % Function to create a sparse bitset from a range of Unicode\n % codepoints. These codepoints are checked for validity, any invalid\n % codepoints are ignored. Throws an exception if cr_first value is less\n % than cr_last.\n %\n:- func charset(char_range) = charset.\n\n % Creates a union of all char ranges in the list. Returns the empty\n % set if the list is empty. Any invalid codepoints are ignored.\n %\n:- func charset_from_ranges(list(char_range)) = charset.\n\n % Latin is comprised of the following Unicode blocks:\n % * Basic Latin\n % * Latin1 Supplement\n % * Latin Extended-A\n % * Latin Extended-B\n %\n:- func latin_chars = charset is det.\n\n % Utility predicate to create ignore_pred's.\n % Use it in the form `ignore(my_token)' to ignore just `my_token'.\n %\n:- pred ignore(Token::in, Token::in) is semidet.\n\n % Utility function to return noval tokens.\n % Use it in the form `return(my_token) inside a lexeme definition.\n %\n:- func return(T, string) = T.\n\n % Utility operator to create lexemes.\n %\n:- func (T1 -> token_creator(Tok)) = pair(regexp, token_creator(Tok))\n <= regexp(T1).\n\n % Construct a lexer from which we can generate running\n % instances.\n %\n % NOTE: If several lexemes match the same string only\n % the token generated by the one closest to the start\n % of the list of lexemes is returned.\n %\n:- func init(list(lexeme(Tok)), read_pred(Src)) = lexer(Tok, Src).\n:- mode init(in, in(read_pred)) = out is det.\n\n % Construct a lexer from which we can generate running\n % instances. If we construct a lexer with init/4, we\n % can additionally ignore specific tokens.\n %\n % NOTE: If several lexemes match the same string only\n % the token generated by the one closest to the start\n % of the list of lexemes is returned.\n %\n:- func init(list(lexeme(Tok)), read_pred(Src), ignore_pred(Tok)) =\n lexer(Tok, Src).\n:- mode init(in, in(read_pred), in(ignore_pred)) = out is det.\n\n % Handy read predicates.\n %\n:- pred read_from_stdin(offset, read_result, io, io).\n:- mode read_from_stdin(in, out, di, uo) is det.\n\n:- pred read_from_stream(text_input_stream, offset, read_result, io, io).\n:- mode read_from_stream(in, in, out, di, uo) is det.\n\n:- pred read_from_string(offset, read_result, string, string).\n:- mode read_from_string(in, out, di, uo) is det.\n\n % Generate a running instance of a lexer on some input source.\n % If you want to lex strings, you must ensure they are unique\n % by calling either copy/1 or unsafe_promise_unique/1 on the\n % source string argument.\n %\n % Note that you can't get the input source back until you stop\n % lexing.\n %\n:- func start(lexer(Tok, Src), Src) = lexer_state(Tok, Src).\n:- mode start(in, di) = uo is det.\n\n % Read the next token from the input stream.\n %\n % CAVEAT: if the token returned happened to match the empty\n % string then you must use read_char/3 (below) to consume\n % the next char in the input stream before calling read/3\n % again, since matching the empty string does not consume\n % any chars from the input stream and will otherwise mean\n % you simply get the same match ad infinitum.\n %\n % An alternative solution is to always include a \"catch all\"\n % lexeme that matches any unexpected char at the end of the\n % list of lexemes.\n %\n:- pred read(io.read_result(Tok),\n lexer_state(Tok, Src), lexer_state(Tok, Src)).\n:- mode read(out, di, uo) is det.\n\n % Calling offset_from_start/3 immediately prior to calling read/3\n % will give the offset in chars from the start of the input stream\n % for the result returned by the read/3 operation.\n %\n:- pred offset_from_start(offset,\n lexer_state(Tok, Src), lexer_state(Tok, Src)).\n:- mode offset_from_start(out, di, uo) is det.\n\n % Stop a running instance of a lexer and retrieve the input source.\n %\n:- func stop(lexer_state(_Tok, Src)) = Src.\n:- mode stop(di) = uo is det.\n\n % Sometimes (e.g. when lexing the io.io) you want access to the\n % input stream without interrupting the lexing process. This pred\n % provides that sort of access.\n %\n:- pred manipulate_source(pred(Src, Src),\n lexer_state(Tok, Src), lexer_state(Tok, Src)).\n:- mode manipulate_source(pred(di, uo) is det, di, uo) is det.\n\n % This is occasionally useful. It reads the next char from the\n % input stream, without attempting to match it against a lexeme.\n %\n:- pred read_char(read_result, lexer_state(Tok, Src), lexer_state(Tok, Src)).\n:- mode read_char(out, di, uo) is det.\n\n%-----------------------------------------------------------------------------%\n%-----------------------------------------------------------------------------%\n\n:- implementation.\n\n:- include_module lex.automata.\n:- include_module lex.buf.\n:- include_module lex.convert_NFA_to_DFA.\n:- include_module lex.lexeme.\n:- include_module lex.regexp.\n\n:- import_module array.\n:- import_module bool.\n:- import_module exception.\n:- import_module maybe.\n:- import_module require.\n:- import_module int.\n:- import_module map.\n\n:- import_module lex.automata.\n:- import_module lex.buf.\n:- import_module lex.convert_NFA_to_DFA.\n:- import_module lex.lexeme.\n:- import_module lex.regexp.\n\n%-----------------------------------------------------------------------------%\n\n:- type lexer(Token, Source)\n ---> lexer(\n lex_compiled_lexemes :: list(live_lexeme(Token)),\n lex_ignore_pred :: ignore_pred(Token),\n lex_buf_read_pred :: read_pred(Source)\n ).\n\n:- inst lexer\n ---> lexer(ground, ignore_pred, read_pred).\n\n:- type lexer_instance(Token, Source)\n ---> lexer_instance(\n init_lexemes :: list(live_lexeme(Token)),\n init_winner_func :: init_winner_func(Token),\n live_lexemes :: list(live_lexeme(Token)),\n current_winner :: winner(Token),\n buf_state :: buf_state(Source),\n ignore_pred :: ignore_pred(Token)\n ).\n\n:- inst lexer_instance\n ---> lexer_instance(\n live_lexeme_list,\n init_winner_func,\n live_lexeme_list,\n winner,\n buf.buf_state,\n ignore_pred\n ).\n\n:- type live_lexeme(Token)\n == compiled_lexeme(Token).\n:- inst live_lexeme\n == compiled_lexeme.\n:- inst live_lexeme_list\n == list.list_skel(live_lexeme).\n\n:- type init_winner_func(Token)\n == ( func(offset) = winner(Token) ).\n:- inst init_winner_func\n == ( func(in) = out is det ).\n\n\n\n:- type winner(Token)\n == maybe(pair(token_creator(Token), offset)).\n:- inst winner\n ---> yes(pair(token_creator, ground))\n ; no.\n\n%-----------------------------------------------------------------------------%\n\nignore(Tok, Tok).\n\n%-----------------------------------------------------------------------------%\n\nreturn(Token, _) = Token.\n\n%-----------------------------------------------------------------------------%\n\n(R1 -> TC) = (re(R1) - TC).\n\n%-----------------------------------------------------------------------------%\n\ninit(Lexemes, BufReadPred) = init(Lexemes, BufReadPred, DontIgnoreAnything) :-\n DontIgnoreAnything = ( pred(_::in) is semidet :- semidet_fail ).\n\ninit(Lexemes, BufReadPred, IgnorePred) =\n lexer(CompiledLexemes, IgnorePred, BufReadPred)\n :-\n CompiledLexemes = list.map(compile_lexeme, Lexemes).\n\n%-----------------------------------------------------------------------------%\n\nstart(Lexer0, Src) = State :-\n Lexer = lexer_inst_cast(Lexer0),\n init_lexer_instance(Lexer, Instance, Buf),\n State = args_lexer_state(Instance, Buf, Src).\n\n:- func lexer_inst_cast(lexer(Tok, Src)::in) = (lexer(Tok, Src)::out(lexer))\n is det.\n\n:- pragma foreign_proc(\"C\",\n lexer_inst_cast(Lexer0::in) = (Lexer::out(lexer)),\n [will_not_call_mercury, promise_pure, thread_safe],\n\"\n Lexer = Lexer0;\n\").\n\n:- pragma foreign_proc(\"Java\",\n lexer_inst_cast(Lexer0::in) = (Lexer::out(lexer)),\n [will_not_call_mercury, promise_pure, thread_safe],\n\"\n Lexer = Lexer0;\n\").\n\n:- pragma foreign_proc(\"C#\",\n lexer_inst_cast(Lexer0::in) = (Lexer::out(lexer)),\n [will_not_call_mercury, promise_pure, thread_safe],\n\"\n Lexer = Lexer0;\n\").\n\n%-----------------------------------------------------------------------------%\n\n:- pred init_lexer_instance(lexer(Tok, Src), lexer_instance(Tok, Src), buf).\n:- mode init_lexer_instance(in(lexer), out(lexer_instance), array_uo) is det.\n\ninit_lexer_instance(Lexer, Instance, Buf) :-\n buf.init(Lexer ^ lex_buf_read_pred, BufState, Buf),\n Start = BufState ^ start_offset,\n InitWinnerFunc = initial_winner_func(InitLexemes),\n InitLexemes = Lexer ^ lex_compiled_lexemes,\n InitWinner = InitWinnerFunc(Start),\n IgnorePred = Lexer ^ lex_ignore_pred,\n Instance = lexer_instance(InitLexemes, InitWinnerFunc, InitLexemes,\n InitWinner, BufState, IgnorePred).\n\n%-----------------------------------------------------------------------------%\n\n % Lexing may *start* with a candidate winner if one of the lexemes\n % accepts the empty string. We pick the first such, if any, since\n % that lexeme has priority.\n %\n:- func initial_winner_func(list(live_lexeme(Token))) = init_winner_func(Token).\n:- mode initial_winner_func(in(live_lexeme_list) ) = out(init_winner_func)\n is det.\n\ninitial_winner_func([] ) =\n ( func(_) = no ).\n\ninitial_winner_func( [L | Ls]) =\n ( if in_accepting_state(L)\n then ( func(Offset) = yes(L ^ token - Offset) )\n else initial_winner_func(Ls)\n ).\n\n%----------------------------------------------------------------------------%\n\noffset_from_start(Offset, !State) :-\n Offset = !.State ^ run ^ buf_state ^ buf_cursor,\n !:State = unsafe_promise_unique(!.State).\n\n%-----------------------------------------------------------------------------%\n\nstop(State) = Src :-\n lexer_state_args(State, _Instance, _Buf, Src).\n\n%-----------------------------------------------------------------------------%\n\nread(Result, State0, State) :-\n\n lexer_state_args(State0, Instance0, Buf0, Src0),\n BufState0 = Instance0 ^ buf_state,\n Start = BufState0 ^ start_offset,\n InitWinner = ( Instance0 ^ init_winner_func )(Start),\n Instance1 = ( Instance0 ^ current_winner := InitWinner ),\n read_2(Result, Instance1, Instance, Buf0, Buf, Src0, Src),\n State = args_lexer_state(Instance, Buf, Src).\n\n\n\n:- pred read_2(io.read_result(Tok),\n lexer_instance(Tok, Src), lexer_instance(Tok, Src),\n buf, buf, Src, Src).\n:- mode read_2(out,\n in(lexer_instance), out(lexer_instance),\n array_di, array_uo, di, uo) is det.\n\n % Basically, just read chars from the buf and advance the live lexemes\n % until we have a winner or hit an error (no parse).\n %\nread_2(Result, !Instance, !Buf, !Src) :-\n\n BufState0 = !.Instance ^ buf_state,\n\n buf.read(BufReadResult, BufState0, BufState, !Buf, !Src),\n (\n BufReadResult = ok(Char),\n process_char(Result, Char, !Instance, BufState, !Buf, !Src)\n ;\n BufReadResult = eof,\n process_eof(Result, !Instance, BufState, !.Buf)\n ).\n\n%-----------------------------------------------------------------------------%\n\n:- pred process_char(io.read_result(Tok), char,\n lexer_instance(Tok, Src), lexer_instance(Tok, Src),\n buf_state(Src), buf, buf, Src, Src).\n:- mode process_char(out, in, in(lexer_instance), out(lexer_instance),\n in(buf_state), array_di, array_uo, di, uo) is det.\n\nprocess_char(Result, Char, !Instance, BufState, !Buf, !Src) :-\n\n LiveLexemes0 = !.Instance ^ live_lexemes,\n Winner0 = !.Instance ^ current_winner,\n\n advance_live_lexemes(Char, BufState ^ cursor_offset,\n LiveLexemes0, LiveLexemes, Winner0, Winner),\n (\n LiveLexemes = [], % Nothing left to consider.\n\n process_any_winner(Result, Winner, !Instance, BufState, !Buf, !Src)\n ;\n LiveLexemes = [_ | _], % Still some open possibilities.\n\n !:Instance = (((!.Instance ^ live_lexemes := LiveLexemes )\n ^ current_winner := Winner )\n ^ buf_state := BufState ),\n read_2(Result, !Instance, !Buf, !Src)\n ).\n\n%-----------------------------------------------------------------------------%\n\n:- pred process_any_winner(io.read_result(Tok), winner(Tok),\n lexer_instance(Tok, Src), lexer_instance(Tok, Src),\n buf_state(Src), buf, buf, Src, Src).\n:- mode process_any_winner(out, in(winner),\n in(lexer_instance), out(lexer_instance),\n in(buf_state), array_di, array_uo, di, uo) is det.\n\nprocess_any_winner(Result, yes(TokenCreator - Offset), Instance0, Instance,\n BufState0, Buf0, Buf, Src0, Src) :-\n\n BufState1 = rewind_cursor(Offset, BufState0),\n String = string_to_cursor(BufState1, Buf0),\n Token = TokenCreator(String),\n IgnorePred = Instance0 ^ ignore_pred,\n InitWinner = ( Instance0 ^ init_winner_func )(Offset),\n Instance1 = ((( Instance0\n ^ live_lexemes := Instance0 ^ init_lexemes )\n ^ current_winner := InitWinner )\n ^ buf_state := commit(BufState1) ),\n\n ( if IgnorePred(Token) then\n\n % We have to be careful to avoid an infinite loop here.\n % If the longest match was the empty string, then the\n % next char in the input stream cannot start a match,\n % so it must be reported as an error.\n %\n ( if String = \"\" then\n buf.read(BufResult, BufState1, BufState, Buf0, Buf, Src0, Src),\n (\n BufResult = ok(_),\n Result = error(\"input not matched by any regexp\", Offset)\n ;\n BufResult = eof,\n Result = eof\n ),\n Instance = ( Instance1 ^ buf_state := commit(BufState) )\n else\n read_2(Result, Instance1, Instance, Buf0, Buf, Src0, Src)\n )\n else\n Result = ok(Token),\n Instance = Instance1,\n Buf = Buf0,\n Src = Src0\n ).\n\nprocess_any_winner(Result, no, !Instance,\n BufState0, !Buf, !Src) :-\n\n Start = BufState0 ^ start_offset,\n BufState = rewind_cursor(Start + 1, BufState0),\n Result = error(\"input not matched by any regexp\", Start),\n\n InitWinner = ( !.Instance ^ init_winner_func )(Start),\n !:Instance = ((( !.Instance ^ live_lexemes := !.Instance ^ init_lexemes )\n ^ current_winner := InitWinner )\n ^ buf_state := commit(BufState) ).\n\n%-----------------------------------------------------------------------------%\n\n:- pred process_eof(io.read_result(Tok),\n lexer_instance(Tok, Src), lexer_instance(Tok, Src),\n buf_state(Src), buf).\n:- mode process_eof(out, in(lexer_instance), out(lexer_instance),\n in(buf_state), array_ui) is det.\n\nprocess_eof(Result, !Instance, !.BufState, !.Buf) :-\n\n CurrentWinner = !.Instance ^ current_winner,\n (\n CurrentWinner = no,\n Offset = !.BufState ^ cursor_offset,\n Result = eof\n ;\n CurrentWinner = yes(TokenCreator - Offset),\n String = string_to_cursor(!.BufState, !.Buf),\n Token = TokenCreator(String),\n IgnorePred = !.Instance ^ ignore_pred,\n Result = ( if IgnorePred(Token) then eof else ok(Token) )\n ),\n InitWinner = ( !.Instance ^ init_winner_func )(Offset),\n !:Instance = ((( !.Instance ^ live_lexemes := !.Instance ^ init_lexemes )\n ^ current_winner := InitWinner )\n ^ buf_state := commit(!.BufState) ).\n\n%-----------------------------------------------------------------------------%\n\n % Note that in the case where two or more lexemes match the same\n % string, the win is given to the earliest such lexeme in the list.\n % This matches the behaviour of standard C lex.\n %\n:- pred advance_live_lexemes(char, offset,\n list(live_lexeme(Token)), list(live_lexeme(Token)),\n winner(Token), winner(Token)).\n:- mode advance_live_lexemes(in, in, in(live_lexeme_list),\n out(live_lexeme_list),\n in(winner), out(winner)) is det.\n\nadvance_live_lexemes(_Char, _Offset, [], [], !Winner).\n\nadvance_live_lexemes(Char, Offset, [L | Ls0], Ls, !Winner) :-\n\n State0 = L ^ state,\n\n ( if next_state(L, State0, Char, State, IsAccepting) then\n\n (\n IsAccepting = no\n ;\n IsAccepting = yes,\n !:Winner = ( if !.Winner = yes(_ - Offset)\n then !.Winner\n else yes(L ^ token - Offset)\n )\n ),\n advance_live_lexemes(Char, Offset, Ls0, Ls1, !Winner),\n Ls = [( L ^ state := State ) | Ls1]\n\n else\n\n advance_live_lexemes(Char, Offset, Ls0, Ls, !Winner)\n ).\n\n%-----------------------------------------------------------------------------%\n\n:- pred live_lexeme_in_accepting_state(list(live_lexeme(Tok)),\n token_creator(Tok)).\n:- mode live_lexeme_in_accepting_state(in(live_lexeme_list),\n out(token_creator)) is semidet.\n\nlive_lexeme_in_accepting_state([L | Ls], Token) :-\n ( if in_accepting_state(L)\n then Token = L ^ token\n else live_lexeme_in_accepting_state(Ls, Token)\n ).\n\n\n%-----------------------------------------------------------------------------%\n%-----------------------------------------------------------------------------%\n\n % It's much more convenient (especially for integration with, e.g.\n % parsers such as moose) to package up the lexer_instance, buf\n % and Src in a single object.\n\n:- type lexer_state(Tok, Src)\n ---> lexer_state(\n run :: lexer_instance(Tok, Src),\n buf :: buf,\n src :: Src\n ).\n\n%-----------------------------------------------------------------------------%\n\n:- func args_lexer_state(lexer_instance(Tok, Src), buf, Src) =\n lexer_state(Tok, Src).\n:- mode args_lexer_state(in(lexer_instance), array_di, di) = uo is det.\n\nargs_lexer_state(Instance, Buf, Src) = LexerState :-\n unsafe_promise_unique(lexer_state(Instance, Buf, Src), LexerState).\n\n%-----------------------------------------------------------------------------%\n\n:- pred lexer_state_args(lexer_state(Tok, Src), lexer_instance(Tok, Src),\n buf, Src).\n:- mode lexer_state_args(di, out(lexer_instance),\n array_uo, uo) is det.\n\nlexer_state_args(lexer_state(Instance, Buf0, Src0), Instance, Buf, Src) :-\n unsafe_promise_unique(Buf0, Buf),\n unsafe_promise_unique(Src0, Src).\n\n%-----------------------------------------------------------------------------%\n\nmanipulate_source(P, !State) :-\n lexer_state_args(!.State, Instance, Buf, Src0),\n P(Src0, Src),\n !:State = args_lexer_state(Instance, Buf, Src).\n\n%----------------------------------------------------------------------------%\n\nread_char(Result, !State) :-\n\n lexer_state_args(!.State, Instance0, Buf0, Src0),\n\n BufState0 = Instance0 ^ buf_state,\n buf.read(Result, BufState0, BufState, Buf0, Buf, Src0, Src),\n Instance = ( Instance0 ^ buf_state := commit(BufState) ),\n\n !:State = args_lexer_state(Instance, Buf, Src).\n\n%-----------------------------------------------------------------------------%\n\nread_from_stdin(_Offset, Result) -->\n io.read_char(IOResult),\n { IOResult = ok(Char), Result = ok(Char)\n ; IOResult = eof, Result = eof\n ; IOResult = error(_E), throw(IOResult)\n }.\n\nread_from_stream(Stream, _Offset, Result) -->\n io.read_char(Stream, IOResult),\n { IOResult = ok(Char), Result = ok(Char)\n ; IOResult = eof, Result = eof\n ; IOResult = error(_E), throw(IOResult)\n }.\n\n%-----------------------------------------------------------------------------%\n\n % XXX This is bad for long strings! We should cache the string\n % length somewhere rather than recomputing it each time we read\n % a char.\n %\nread_from_string(Offset, Result, String, unsafe_promise_unique(String)) :-\n ( if Offset < string.length(String)\n then Result = ok(string.unsafe_index(String, Offset))\n else Result = eof\n ).\n\n%-----------------------------------------------------------------------------%\n% The type of regular expressions.\n\n:- type regexp\n ---> eps % The empty regexp\n ; atom(char) % Match a single char\n ; conc(regexp, regexp) % Concatenation\n ; alt(regexp, regexp) % Alternation\n ; star(regexp) % Kleene closure\n ; charset(charset). % Matches any char in the set\n\n%-----------------------------------------------------------------------------%\n\n:- instance regexp(regexp) where [\n re(RE) = RE\n].\n\n:- instance regexp(char) where [\n re(C) = atom(C)\n].\n\n:- instance regexp(string) where [\n re(S) = R :-\n ( if S = \"\" then\n R = null\n else\n R = string.foldl(func(Char, R0) = R1 :-\n ( if R0 = eps then R1 = re(Char) else R1 = R0 ++ re(Char) ),\n S,\n eps)\n )\n].\n\n:- instance regexp(sparse_bitset(T)) <= (regexp(T),enum(T)) where [\n re(SparseBitset) = charset(Charset) :-\n Charset = sparse_bitset.foldl(\n func(Enum, Set0) = insert(Set0, char.det_from_int(to_int(Enum))),\n SparseBitset,\n sparse_bitset.init)\n].\n\n%-----------------------------------------------------------------------------%\n% Basic primitive regexps.\n\n null = eps.\n R1 ++ R2 = conc(re(R1), re(R2)).\n R1 \\/ R2 = alt(re(R1), re(R2)).\n(R1 or R2) = alt(re(R1), re(R2)).\n *(R1) = star(re(R1)).\n\n%-----------------------------------------------------------------------------%\n% Some basic non-primitive regexps.\n\n % int_is_valid_char(Int) = Char.\n %\n % True iff Int is Char and is in [0x0..0x10ffff] and not a surrogate\n % character.\n %\n:- func int_is_valid_char(int) = char is semidet.\n\nint_is_valid_char(Value) = Char :-\n char.from_int(Value, Char),\n not char.is_surrogate(Char).\n\ncharset(Start, End) = build_charset(Start, End, sparse_bitset.init) :-\n expect(Start =< End, $file, $pred,\n \"Start must be less than or equal to End\").\n\ncharset(char_range(First, Last)) = charset(First, Last).\n\n:- func build_charset(int, int, charset) = charset.\n\nbuild_charset(First, Last, Charset0) = Charset :-\n if First =< Last then\n ( if int_is_valid_char(First) = Char then\n Charset1 = sparse_bitset.insert(Charset0, Char)\n else\n Charset1 = Charset0\n ),\n Charset = build_charset(First + 1, Last, Charset1)\n else\n Charset = Charset0.\n\ncharset_from_ranges(ListOfRanges) =\n union_list(map(charset, ListOfRanges)).\n\nlatin_chars = charset_from_ranges([\n char_range(0x40, 0x7d),\n char_range(0xc0, 0xff),\n char_range(0x100, 0x2ff)\n ]).\n\n:- func valid_unicode_chars = charset.\n\nvalid_unicode_chars = charset(char_range(0x01, 0xffff)).\n\n:- func iso_chars = charset.\n\niso_chars = charset(char_range(0x01, 0xff)).\n\nany(S) = R :-\n ( if S = \"\" then\n R = null\n else\n R = re(sparse_bitset.list_to_set(string.to_char_list(S)))\n ).\n\nanybut(S) = R :-\n ExcludedChars = sparse_bitset.list_to_set(string.to_char_list(S)),\n R = re(sparse_bitset.difference(iso_chars, ExcludedChars)).\n\n?(R) = (R or null).\n\n+(R) = (R ++ *(R)).\n\nrange(Start, End) = re(charset(char.to_int(Start), char.to_int(End))).\n\nR * N = Result :-\n ( N < 0 ->\n unexpected($file, $pred, \"N must be a non-negative number\")\n ; N = 0 ->\n Result = null\n ; N = 1 ->\n Result = re(R)\n ;\n Result = conc(re(R), (R * (N - 1)))\n ).\n\n%-----------------------------------------------------------------------------%\n% Some useful single-char regexps.\n\n % We invite the compiler to memo the values of these constants that\n % (a) are likely to be quite common in practice and (b) take *some*\n % time to compute.\n %\n:- pragma memo(digit/0).\n:- pragma memo(lower/0).\n:- pragma memo(upper/0).\n:- pragma memo(wspc/0).\n:- pragma memo(dot/0).\n\ndigit = any(\"0123456789\").\nlower = any(\"abcdefghijklmnopqrstuvwxyz\").\nupper = any(\"ABCDEFGHIJKLMNOPQRSTUVWXYZ\").\nwspc = any(\" \\t\\n\\r\\f\\v\").\ndot = anybut(\"\\r\\n\").\nalpha = (lower or upper).\nalphanum = (alpha or digit).\nidentstart = (alpha or ('_')).\nident = (alphanum or ('_')).\ntab = re('\\t').\nspc = re(' ').\n\n%-----------------------------------------------------------------------------%\n% Some useful compound regexps.\n\nnl = (?('\\r') ++ '\\n'). % matches both Posix and Windows newline.\nnat = +(digit).\nsigned_int = ?(\"+\" or \"-\") ++ nat.\nreal = signed_int ++ (\n (\".\" ++ nat ++ ?((\"e\" or \"E\") ++ signed_int)) or\n ( (\"e\" or \"E\") ++ signed_int)\n ).\nidentifier = (identstart ++ *(ident)).\nwhitespace = +(wspc).\njunk = +(dot).\n\n%-----------------------------------------------------------------------------%\n%-----------------------------------------------------------------------------%\n" }, { "path": "src/lex.regexp.m", "content": "%-----------------------------------------------------------------------------%\n% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix\n%-----------------------------------------------------------------------------%\n%\n% lex.regexp.m\n% Fri Aug 18 06:43:09 BST 2000\n% Copyright (C) 2001 Ralph Becket \n% Copyright (C) 2001 The Rationalizer Intelligent Software AG\n% The changes made by Rationalizer are contributed under the terms \n% of the GNU Lesser General Public License, see the file COPYING.LGPL\n% in this directory.\n% Copyright (C) 2002, 2010 The University of Melbourne\n%\n% This file may only be copied under the terms of the GNU Library General\n% Public License - see the file COPYING.LIB in the Mercury distribution.\n%\n% Thu Jul 26 07:45:47 UTC 2001\n%\n% Converts basic regular expressions into non-deterministic finite\n% automata (NFAs).\n%\n%-----------------------------------------------------------------------------%\n\n:- module lex.regexp.\n:- interface.\n\n:- import_module lex.automata.\n\n % Turn a regexp into an NFA.\n %\n:- func regexp_to_NFA(regexp) = state_mc.\n\n % Turn an NFA into a null transition-free NFA.\n %\n:- func remove_null_transitions(state_mc) = state_mc.\n:- mode remove_null_transitions(in) = out(null_transition_free_state_mc) is det.\n\n%-----------------------------------------------------------------------------%\n%-----------------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module assoc_list.\n:- import_module counter.\n:- import_module list.\n:- import_module map.\n:- import_module set.\n:- import_module std_util.\n:- import_module string.\n:- import_module sparse_bitset.\n\n%-----------------------------------------------------------------------------%\n\nregexp_to_NFA(R) = NFA :-\n C0 = counter.init(0),\n counter.allocate(Start, C0, C1),\n counter.allocate(Stop, C1, C),\n compile(Start, R, Stop, Transitions, C, _),\n NFA = state_mc(Start, set.make_singleton_set(Stop), Transitions).\n\n%-----------------------------------------------------------------------------%\n\n:- pred compile(state_no, regexp, state_no, transitions, counter, counter).\n:- mode compile(in, in, in, out, in, out) is det.\n\n % The primitive regexps.\n\ncompile(X, eps, Y, [null(X, Y)]) --> [].\n\ncompile(X, atom(C), Y, [trans(X, make_singleton_set(C), Y)]) --> [].\n\ncompile(X, charset(Charset), Y, [trans(X, Charset, Y)]) --> [].\n\ncompile(X, conc(RA,RB), Y, TsA ++ TsB) -->\n counter.allocate(Z),\n compile(X, RA, Z, TsA),\n compile(Z, RB, Y, TsB).\n\ncompile(X, alt(RA, RB), Y, TsA ++ TsB) -->\n compile(X, RA, Y, TsA),\n compile(X, RB, Y, TsB).\n\ncompile(X, star(R), Y, TsA ++ TsB) -->\n compile(X, null, Y, TsA),\n compile(X, R, X, TsB).\n\n%-----------------------------------------------------------------------------%\n\n % If we have a non-looping null transition from X to Y then\n % we need to add all the transitions from Y to X.\n %\n % We do this by first finding the transitive closure of the\n % null transition graph and then, for each edge X -> Y in that\n % graph, adding X -C-> Z for all C and Z s.t. Y -C-> Z.\n %\nremove_null_transitions(NFA0) = NFA :-\n\n Ts = NFA0 ^ smc_state_transitions,\n split_transitions(Ts, NullTs, CharTs),\n trans_closure(NullTs, map.init, _Ins, map.init, Outs),\n NullFreeTs = add_atom_transitions(Outs, CharTs),\n\n StopStates0 = NFA0 ^ smc_stop_states,\n StopStates1 =\n set.list_to_set(\n list.filter_map(\n nulls_to_stop_state(Outs, NFA0 ^ smc_stop_states),\n NullTs\n )\n ),\n StopStates = StopStates0 `set.union` StopStates1,\n\n NFA = (( NFA0\n ^ smc_state_transitions := NullFreeTs )\n ^ smc_stop_states := StopStates).\n\n\n%-----------------------------------------------------------------------------%\n\n:- pred split_transitions(transitions, transitions, transitions).\n:- mode split_transitions(in, out(null_transitions), out(atom_transitions)).\n\nsplit_transitions([], [], []).\n\nsplit_transitions([null(X, Y) | Ts], [null(X, Y) | NTs], CTs) :-\n split_transitions(Ts, NTs, CTs).\n\nsplit_transitions([trans(X, C, Y) | Ts], NTs, [trans(X, C, Y) | CTs]) :-\n split_transitions(Ts, NTs, CTs).\n\n%-----------------------------------------------------------------------------%\n\n:- type null_map == map(state_no, set(state_no)).\n\n:- pred trans_closure(transitions, null_map, null_map, null_map, null_map).\n:- mode trans_closure(in(null_transitions), in, out, in, out) is det.\n\ntrans_closure([], !Ins, !Outs).\ntrans_closure([T | Ts], !Ins, !Outs) :-\n T = null(X, Y),\n XInAndX = set.insert(null_map_lookup(X, !.Ins), X),\n YOutAndY = set.insert(null_map_lookup(Y, !.Outs), Y),\n !:Outs = set.fold(add_to_null_mapping(YOutAndY), XInAndX, !.Outs),\n !:Ins = set.fold(add_to_null_mapping(XInAndX), YOutAndY, !.Ins),\n trans_closure(Ts, !Ins, !Outs).\n\n%-----------------------------------------------------------------------------%\n\n:- func null_map_lookup(state_no, null_map) = set(state_no).\n\nnull_map_lookup(X, Map) =\n ( if map.search(Map, X, Ys) then Ys else set.init ).\n\n%-----------------------------------------------------------------------------%\n\n:- func add_to_null_mapping(set(state_no), state_no, null_map) = null_map.\n\nadd_to_null_mapping(Xs, Y, Map) =\n map.set(Map, Y, Xs `set.union` null_map_lookup(Y, Map)).\n\n%-----------------------------------------------------------------------------%\n\n % XXX add_atom_transitions (and its callees) originally used the inst-\n % subtyping given in the commented out mode declarations. Limitations in\n % the compiler meant that this code compiled when it was originally written\n % but with more recent versions of the compiler it causes a compilation\n % error due to the aforementioned limitations having been lifted.\n %\n % As a workaround we perform a runtime check in maybe_copy_transition/4\n % below and then use an unsafe cast (defined via a foreign_proc) to restore\n % the subtype inst. Doing so means that other code in this library that\n % uses the same inst-subtyping continues to work without modification.\n %\n % If / when the standard library has versions of list.condense, list.map etc\n % that preserve subtype insts then the original modes can be restored (and\n % the workarounds deleted).\n %\n:- func add_atom_transitions(null_map, transitions) = transitions.\n:- mode add_atom_transitions(in, in(atom_transitions)) = out(atom_transitions).\n\nadd_atom_transitions(Outs, CTs) = NullFreeTs :-\n NullFreeTs0 = list.sort_and_remove_dups(\n list.condense(\n [ CTs\n | list.map(\n add_atom_transitions_0(CTs),\n map.to_assoc_list(Outs)\n )\n ]\n )\n ),\n unsafe_cast_to_atom_transitions(NullFreeTs0, NullFreeTs).\n\n:- pred unsafe_cast_to_atom_transitions(transitions::in,\n transitions::out(atom_transitions)) is det.\n\n:- pragma foreign_proc(\"C\",\n unsafe_cast_to_atom_transitions(X::in, Y::out(atom_transitions)),\n [promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail],\n\"\n Y = X;\n\").\n\n:- pragma foreign_proc(\"Java\",\n unsafe_cast_to_atom_transitions(X::in, Y::out(atom_transitions)),\n [promise_pure, will_not_call_mercury, thread_safe],\n\"\n Y = X;\n\").\n\n:- pragma foreign_proc(\"C#\",\n unsafe_cast_to_atom_transitions(X::in, Y::out(atom_transitions)),\n [promise_pure, will_not_call_mercury, thread_safe],\n\"\n Y = X;\n\").\n\n%-----------------------------------------------------------------------------%\n\n:- func add_atom_transitions_0(transitions, pair(state_no, set(state_no))) =\n transitions.\n%:- mode add_atom_transitions_0(in(atom_transitions), in) =\n% out(atom_transitions) is det.\n\nadd_atom_transitions_0(CTs, X - Ys) =\n list.condense(\n list.map(add_atom_transitions_1(CTs, X), set.to_sorted_list(Ys))\n ).\n\n%-----------------------------------------------------------------------------%\n\n:- func add_atom_transitions_1(transitions, state_no, state_no) = transitions.\n%:- mode add_atom_transitions_1(in(atom_transitions), in, in) =\n% out(atom_transitions) is det.\n\nadd_atom_transitions_1(CTs0, X, Y) = CTs :-\n list.filter_map(maybe_copy_transition(X, Y), CTs0, CTs).\n\n%-----------------------------------------------------------------------------%\n\n:- pred maybe_copy_transition(state_no, state_no, transition, transition).\n%:- mode maybe_copy_transition(in,in,in(atom_transition),out(atom_transition))\n% is semidet.\n:- mode maybe_copy_transition(in, in, in, out) is semidet.\n\nmaybe_copy_transition(_, _, null(_, _) , _) :-\n unexpected($file, $pred, \"null transition\").\nmaybe_copy_transition(X, Y, trans(Y, C, Z), trans(X, C, Z)).\n\n%-----------------------------------------------------------------------------%\n\n:- func nulls_to_stop_state(null_map, set(state_no), transition) = state_no.\n:- mode nulls_to_stop_state(in, in, in) = out is semidet.\n\nnulls_to_stop_state(Outs, StopStates, null(X, _Y)) = X :-\n some [Z] (\n set.member(Z, map.lookup(Outs, X)),\n set.member(Z, StopStates)\n ).\n\n%-----------------------------------------------------------------------------%\n:- end_module lex.regexp.\n%-----------------------------------------------------------------------------%\n" }, { "path": "src/options.m", "content": "%-----------------------------------------------------------------------%\n% Plasma compiler options\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% The options structure for the Plasma compiler.\n%\n%-----------------------------------------------------------------------%\n:- module options.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module bool.\n:- import_module maybe.\n\n:- import_module util.\n:- import_module util.log.\n\n%-----------------------------------------------------------------------%\n\n:- type general_options\n ---> general_options(\n % High-level options\n go_dir :: string, % The directory of\n % the input file.\n go_source_dir :: string, % Trim this prefix\n % from paths in error\n % messages.\n go_input_file :: string,\n go_output_file :: string,\n\n go_import_whitelist_file :: maybe(string),\n go_module_name_check :: maybe(string),\n\n go_warn_as_error :: bool,\n\n % Diagnostic options.\n go_verbose :: log_config,\n go_dump_stages :: dump_stages,\n go_write_output :: write_output,\n go_report_timing :: report_timing\n ).\n\n:- type compile_options\n ---> compile_options(\n % Feature/optimisation options\n % Although we're not generally implementing optimisations or\n % these options control some optional transformations during\n % compilation, by making them options they're easier toe\n % test.\n co_do_simplify :: do_simplify,\n co_enable_tailcalls :: enable_tailcalls\n ).\n\n:- type dump_stages\n ---> dump_stages\n ; dont_dump_stages.\n\n:- type write_output\n ---> write_output\n ; dont_write_output.\n\n:- type report_timing\n ---> no_timing\n ; report_command_times.\n\n:- type do_simplify\n ---> do_simplify_pass\n ; skip_simplify_pass.\n\n:- type enable_tailcalls\n ---> enable_tailcalls\n ; dont_enable_tailcalls.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/parse.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module parse.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Plasma parser\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n\n:- import_module ast.\n:- import_module parse_util.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- pred parse(string::in, result(ast, read_src_error)::out,\n io::di, io::uo) is det.\n\n:- pred parse_interface(string::in, result(ast_interface, read_src_error)::out,\n io::di, io::uo) is det.\n\n:- pred parse_typeres(string::in, result(ast_typeres, read_src_error)::out,\n io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module char.\n:- import_module int.\n:- import_module list.\n:- import_module maybe.\n:- import_module require.\n:- import_module std_util.\n:- import_module solutions.\n:- import_module string.\n:- import_module unit.\n\n:- import_module common_types.\n:- import_module context.\n:- import_module lex.\n:- import_module parsing.\n:- import_module q_name.\n:- import_module util.my_exception.\n:- import_module util.my_string.\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\nparse(Filename, Result, !IO) :-\n parse_file(Filename, lexemes, ignore_tokens, check_token, parse_plasma,\n Result, !IO).\n\nparse_interface(Filename, Result, !IO) :-\n parse_file(Filename, lexemes, ignore_tokens, check_token,\n parse_plasma_interface(parse_interface_entry), Result, !IO).\n\nparse_typeres(Filename, Result, !IO) :-\n parse_file(Filename, lexemes, ignore_tokens, check_token,\n parse_plasma_interface(parse_typeres_entry), Result, !IO).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- type token_type\n ---> module_\n ; export\n ; entrypoint\n ; import\n ; type_\n ; func_\n ; resource\n ; from\n ; uses\n ; observes\n ; opaque\n ; as\n ; foreign\n ; var\n ; return\n ; match\n ; if_\n ; then_\n ; else_\n ; and_\n ; or_\n ; not_\n ; pragma_\n ; ident\n ; number\n ; string\n ; l_curly\n ; r_curly\n ; l_paren\n ; r_paren\n ; l_square\n ; r_square\n ; l_angle\n ; r_angle\n ; l_square_colon\n ; r_square_colon\n ; apostrophe\n ; colon\n ; comma\n ; period\n ; plus\n ; minus\n ; star\n ; slash\n ; percent\n ; bar\n ; bang\n ; double_plus\n ; l_angle_equal\n ; r_angle_equal\n ; double_equal\n ; bang_equal\n ; equals\n ; l_arrow\n ; r_arrow\n ; underscore\n ; newline\n ; comment\n ; whitespace\n ; eof.\n\n:- instance ident_parsing(token_type) where [\n ident_ = ident,\n period_ = period\n].\n\n:- func lexemes = list(lexeme(lex_token(token_type))).\n\nlexemes = [\n (\"module\" -> return(module_)),\n (\"export\" -> return(export)),\n (\"entrypoint\" -> return(entrypoint)),\n (\"import\" -> return(import)),\n (\"type\" -> return(type_)),\n (\"func\" -> return(func_)),\n (\"resource\" -> return(resource)),\n (\"from\" -> return(from)),\n (\"uses\" -> return(uses)),\n (\"observes\" -> return(observes)),\n (\"opaque\" -> return(opaque)),\n (\"as\" -> return(as)),\n (\"foreign\" -> return(foreign)),\n (\"var\" -> return(var)),\n (\"return\" -> return(return)),\n (\"match\" -> return(match)),\n (\"if\" -> return(if_)),\n (\"then\" -> return(then_)),\n (\"else\" -> return(else_)),\n (\"not\" -> return(not_)),\n (\"and\" -> return(and_)),\n (\"or\" -> return(or_)),\n (\"pragma\" -> return(pragma_)),\n (\"{\" -> return(l_curly)),\n (\"}\" -> return(r_curly)),\n (\"(\" -> return(l_paren)),\n (\")\" -> return(r_paren)),\n (\"[\" -> return(l_square)),\n (\"]\" -> return(r_square)),\n (\"<\" -> return(l_angle)),\n (\">\" -> return(r_angle)),\n (\"[:\" -> return(l_square_colon)),\n (\":]\" -> return(r_square_colon)),\n (\"'\" -> return(apostrophe)),\n (\":\" -> return(colon)),\n (\",\" -> return(comma)),\n (\".\" -> return(period)),\n (\"+\" -> return(plus)),\n (\"-\" -> return(minus)),\n (\"*\" -> return(star)),\n (\"/\" -> return(slash)),\n (\"%\" -> return(percent)),\n (\"|\" -> return(bar)),\n (\"!\" -> return(bang)),\n (\"<\" -> return(l_angle)),\n (\">\" -> return(r_angle)),\n (\"++\" -> return(double_plus)),\n (\"<=\" -> return(l_angle_equal)),\n (\">=\" -> return(r_angle_equal)),\n (\"==\" -> return(double_equal)),\n (\"!=\" -> return(bang_equal)),\n (\"=\" -> return(equals)),\n (\"<-\" -> return(l_arrow)),\n (\"->\" -> return(r_arrow)),\n (\"_\" -> return(underscore)),\n (nat -> return(number)),\n (parse.identifier -> return(ident)),\n % TODO: don't terminate the string on a \\\" escape sequence.\n (\"\\\"\" ++ *(anybut(\"\\\"\")) ++ \"\\\"\"\n -> return(string)),\n\n ((\"//\" ++ *(anybut(\"\\n\")))\n -> return(comment)),\n (c_style_comment -> return(comment)),\n (\"\\n\" -> return(newline)),\n (any(\" \\t\\v\\f\") -> return(whitespace))\n ].\n\n:- func identifier = regexp.\n\nidentifier = alpha ++ *(lex.ident).\n\n % Due to a limitiation in the regex library this wont match /* **/ and\n % other strings where there is a * next to the final */\n %\n:- func c_style_comment = regexp.\n\nc_style_comment = \"/*\" ++ Middle ++ \"*/\" :-\n Middle = *(anybut(\"*\") or (\"*\" ++ anybut(\"/\"))).\n\n:- pred ignore_tokens(token_type::in) is semidet.\n\nignore_tokens(whitespace).\nignore_tokens(newline).\nignore_tokens(comment).\n\n:- pred check_token(token(token_type)::in, maybe(read_src_error)::out) is det.\n\ncheck_token(token(Token, Data, _), Result) :-\n ( if\n % Comments\n Token = comment,\n % that begin with /* (not //)\n append(\"/*\", _, Data),\n Length = length(Data)\n then\n ( if\n % and contain */ are probably a mistake due to the greedy match\n % for the middle part of those comments.\n sub_string_search(Data, \"*/\", Index),\n % Except when it's the last part of the comment.\n Index \\= Length - 2\n then\n Result = yes(rse_tokeniser_greedy_comment)\n else if\n % Have a general warning to help people avoid the odd\n % condition above.\n index(Data, Length - 3, '*'),\n Length > 4\n then\n Result = yes(rse_tokeniser_starstarslash_comment)\n else\n Result = no\n )\n else\n Result = no\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- type tokens == list(token(token_type)).\n\n% Some grammar rules are conditionally enabled depending on what we're\n% parsing.\n:- type parse_type\n ---> parse_source\n ; parse_interface.\n\n:- pred parse_plasma(tokens::in, result(ast, read_src_error)::out)\n is det.\n\n % I will show the EBNF in comments. NonTerminals appear in\n % CamelCase and terminals appear in lower_underscore_case.\n %\n % Plasma := ModuleDecl ToplevelItem*\n %\n % ModuleDecl := module ident\n %\nparse_plasma(!.Tokens, Result) :-\n get_context(!.Tokens, Context),\n match_token(module_, ModuleMatch, !Tokens),\n parse_q_name(NameResult, !Tokens),\n zero_or_more_last_error(parse_entry, ok(Items), LastError, !Tokens),\n ( if\n ModuleMatch = ok(_),\n NameResult = ok(Name)\n then\n ( !.Tokens = [],\n Result = ok(ast(Name, Context, Items))\n ; !.Tokens = [token(Tok, _, TokCtxt) | _],\n LastError = error(LECtxt, Got, Expect),\n ( if compare((<), LECtxt, TokCtxt) then\n Result = return_error(TokCtxt,\n rse_parse_junk_at_end(string(Tok)))\n else\n Result = return_error(LECtxt, rse_parse_error(Got, Expect))\n )\n )\n else\n Result0 = combine_errors_2(ModuleMatch, NameResult) `with_type`\n parse_res(unit),\n ( Result0 = error(C, G, E),\n Result = return_error(C, rse_parse_error(G, E))\n ; Result0 = ok(_),\n unexpected($file, $pred, \"ok/1, expecting error/1\")\n )\n ).\n\n % ToplevelItem := ImportDirective\n % | TypeDefinition\n % | ResourceDefinition\n % | Definition\n % | Pragma\n %\n:- pred parse_entry(parse_res(ast_entry)::out, tokens::in, tokens::out) is det.\n\n % Defintiions exist at the top level and also within code blocks. For\n % now that's just function definitions but it'll include other things in\n % the future.\n %\n % Definition := FuncDefinition\n %\nparse_entry(Result, !Tokens) :-\n or([ parse_import,\n parse_map(func({N, X}) = ast_type(N, X),\n parse_type(parse_nq_name)),\n parse_map(func({N, X}) = ast_resource(N, X),\n parse_resource(parse_nq_name)),\n parse_map(func({N, X}) = ast_function(N, X),\n parse_func(parse_nq_name, parse_source)),\n parse_pragma],\n Result, !Tokens).\n\n % ImportDirective := import QualifiedIdent\n % | import QualifiedIdent as ident\n %\n:- pred parse_import(parse_res(ast_entry)::out, tokens::in, tokens::out)\n is det.\n\nparse_import(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(import, ImportMatch, !Tokens),\n parse_q_name(NameResult, !Tokens),\n ( if\n ImportMatch = ok(_),\n NameResult = ok(Name)\n then\n TokensAs = !.Tokens,\n match_token(as, AsMatch, !Tokens),\n match_token(ident, AsIdentResult, !Tokens),\n ( AsMatch = ok(_),\n ( AsIdentResult = ok(AsIdent),\n Result = ok(ast_import(ast_import(Name, yes(AsIdent),\n Context)))\n ; AsIdentResult = error(C, G, E),\n Result = error(C, G, E)\n )\n ; AsMatch = error(_, _, _),\n Result = ok(ast_import(ast_import(Name, no, Context))),\n !:Tokens = TokensAs\n )\n else\n Result = combine_errors_2(ImportMatch, NameResult)\n ).\n\n:- pred parse_type(parsing.parser(N, token_type), parse_res({N, ast_type(N)}),\n tokens, tokens).\n:- mode parse_type(in(parsing.parser), out, in, out) is det.\n\nparse_type(ParseName, Result, !Tokens) :-\n parse_export_opaque(Sharing, !Tokens),\n get_context(!.Tokens, Context),\n match_token(type_, MatchType, !Tokens),\n ParseName(NameResult, !Tokens),\n ( if\n MatchType = ok(_),\n NameResult = ok(Name)\n then\n match_token(slash, MatchSlash, !Tokens),\n ( MatchSlash = ok(_),\n % Abstract type\n parse_number(NumberRes, !Tokens),\n ( NumberRes = ok(Arity),\n Result = ok({Name, ast_type_abstract(arity(Arity), Context)})\n ; NumberRes = error(C, G, E),\n Result = error(C, G, E)\n )\n ; MatchSlash = error(_, _, _),\n % Concrete type\n optional(within(l_paren, one_or_more_delimited(comma,\n parse_type_var), r_paren), ok(MaybeParams), !Tokens),\n match_token(equals, MatchEquals, !Tokens),\n one_or_more_delimited(bar, parse_type_constructor(ParseName),\n CtrsResult, !Tokens),\n ( if\n MatchEquals = ok(_),\n CtrsResult = ok(Constructors)\n then\n Params = map(\n func(T) = ( if N = T ^ atv_name\n then N\n else unexpected($file, $pred,\n \"not a type variable\")),\n maybe_default([], MaybeParams)),\n Result = ok({Name,\n ast_type(Params, Constructors, Sharing, Context)})\n else\n Result = combine_errors_2(MatchEquals, CtrsResult)\n )\n )\n else\n Result = combine_errors_2(MatchType, NameResult)\n ).\n\n:- pred parse_type_constructor(parsing.parser(N, token_type),\n parse_res(at_constructor(N)), tokens, tokens).\n:- mode parse_type_constructor(in(parsing.parser), out, in, out) is det.\n\nparse_type_constructor(ParseName, Result, !Tokens) :-\n get_context(!.Tokens, Context),\n ParseName(CNameResult, !Tokens),\n optional(within(l_paren,\n one_or_more_delimited(comma, parse_type_ctr_field), r_paren),\n ok(MaybeFields), !Tokens),\n ( CNameResult = ok(CName),\n Result = ok(at_constructor(CName, maybe_default([], MaybeFields),\n Context))\n ; CNameResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_type_ctr_field(parse_res(at_field)::out, tokens::in,\n tokens::out) is det.\n\nparse_type_ctr_field(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(ident, NameResult, !Tokens),\n match_token(colon, MatchColon, !Tokens),\n parse_type_expr(TypeResult, !Tokens),\n ( if\n NameResult = ok(Name),\n MatchColon = ok(_),\n TypeResult = ok(Type)\n then\n Result = ok(at_field(Name, Type, Context))\n else\n Result = combine_errors_3(NameResult, MatchColon, TypeResult)\n ).\n\n % TypeExpr := TypeVar\n % | TypeCtor ( '(' TypeExpr ( ',' TypeExpr )* ')' )?\n % | 'func' '(' ( TypeExpr ( ',' TypeExpr )* )? ')' RetTypes?\n %\n % RetTypes := '->' TypeExpr\n % | '->' '(' TypeExpr ( ',' TypeExpr )* ')'\n %\n % Type := QualifiedIdent\n %\n % TODO: Update to respect case of type names/vars\n %\n:- pred parse_type_expr(parse_res(ast_type_expr)::out,\n tokens::in, tokens::out) is det.\n\nparse_type_expr(Result, !Tokens) :-\n or([parse_type_var, parse_type_construction, parse_func_type], Result,\n !Tokens).\n\n:- pred parse_type_var(parse_res(ast_type_expr)::out,\n tokens::in, tokens::out) is det.\n\nparse_type_var(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(apostrophe, MatchSigil, !Tokens),\n match_token(ident, Result0, !Tokens),\n ( if\n MatchSigil = ok(_),\n Result0 = ok(S)\n then\n Result = ok(ast_type_var(S, Context))\n else\n Result = combine_errors_2(MatchSigil, Result0)\n ).\n\n:- pred parse_type_construction(parse_res(ast_type_expr)::out,\n tokens::in, tokens::out) is det.\n\nparse_type_construction(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n parse_q_name(ConstructorResult, !Tokens),\n % TODO: We could generate more helpful parse errors here, for example by\n % returning the error from within the optional thing if the l_paren is\n % seen.\n optional(within(l_paren, one_or_more_delimited(comma, parse_type_expr),\n r_paren), ok(MaybeArgs), !Tokens),\n ( ConstructorResult = ok(Name),\n ( MaybeArgs = no,\n Args = []\n ; MaybeArgs = yes(Args)\n ),\n Result = ok(ast_type(Name, Args, Context))\n ; ConstructorResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n % Note that the return type cannot contain a comma, or that would be the\n % end of the type as a whole. So we use parens (that should be optional\n % when there's only a single result) to group multiple returns.\n %\n % TODO: This is an exception to the established pattern and so we should\n % update the rest of the grammar to match it (allowing optional parens).\n %\n:- pred parse_func_type(parse_res(ast_type_expr)::out,\n tokens::in, tokens::out) is det.\n\nparse_func_type(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(func_, MatchFunc, !Tokens),\n ( MatchFunc = ok(_),\n within(l_paren, zero_or_more_delimited(comma, parse_type_expr),\n r_paren, ParamsResult, !Tokens),\n\n zero_or_more(parse_uses, ok(Usess), !Tokens),\n Uses = condense(Usess),\n\n optional(parse_returns, ok(MaybeReturns), !Tokens),\n Returns = maybe_default([], MaybeReturns),\n\n ( ParamsResult = ok(Params),\n Result = ok(ast_type_func(Params, Returns, Uses, Context))\n ; ParamsResult = error(C, G, E),\n Result = error(C, G, E)\n )\n ; MatchFunc = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n % ResourceDefinition := 'resource' QualifiedIdent 'from' QualifiedIdent\n %\n:- pred parse_resource(parsing.parser(N, token_type),\n parse_res({N, ast_resource}), tokens, tokens).\n:- mode parse_resource(in(parsing.parser), out, in, out) is det.\n\nparse_resource(ParseName, Result, !Tokens) :-\n parse_export_opaque(Sharing, !Tokens),\n get_context(!.Tokens, Context),\n match_token(resource, ResourceMatch, !Tokens),\n % Not really an any ident, but this should make errors easier to\n % understand. A user will get a \"resource uknown\" if they use the wrong\n % case rather than a syntax error.\n ParseName(NameResult, !Tokens),\n parse_resource_from(FromResult, !Tokens),\n ( if\n ResourceMatch = ok(_),\n NameResult = ok(Name),\n FromResult = ok(FromIdent)\n then\n Result = ok({Name, ast_resource(FromIdent, Sharing, Context)})\n else\n Result = combine_errors_3(ResourceMatch, NameResult, FromResult)\n ).\n\n % Parse a resource from an interface file.\n %\n % ResourceInterface := 'resource' QualifiedIdent ('from' QualifiedIdent)?\n %\n:- pred parse_resource_interface(parse_res({q_name, maybe(ast_resource)})::out,\n tokens::in, tokens::out) is det.\n\nparse_resource_interface(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(resource, ResourceMatch, !Tokens),\n parse_q_name(NameResult, !Tokens),\n ( if\n ResourceMatch = ok(_),\n NameResult = ok(Name)\n then\n optional(parse_resource_from, ok(FromResult), !Tokens),\n ( FromResult = yes(FromName),\n Result = ok({Name, yes(ast_resource(FromName, so_private, Context))})\n ; FromResult = no,\n Result = ok({Name, no})\n )\n else\n Result = combine_errors_2(ResourceMatch, NameResult)\n ).\n\n % Parse the body of a resource definition.\n %\n:- pred parse_resource_from(parse_res(q_name)::out, tokens::in, tokens::out)\n is det.\n\nparse_resource_from(Result, !Tokens) :-\n match_token(from, FromMatch, !Tokens),\n parse_q_name(IdentResult, !Tokens),\n ( if\n FromMatch = ok(_),\n IdentResult = ok(Name)\n then\n Result = ok(Name)\n else\n Result = combine_errors_2(FromMatch, IdentResult)\n ).\n\n % FuncDefinition := 'func' Name '(' ( Param ( ',' Param )* )? ')'\n % Uses* ReturnTypes? FuncBody\n %\n % Depending on the ParseName value that's passed in.\n % Name := ident\n % | QualifiedIdent\n %\n % Param := ident : TypeExpr\n % | TypeExpr (Only in interfaces)\n %\n % Uses := uses QualifiedIdent\n % | uses '(' QualifiedIdentList ')'\n % | observes QualifiedIdent\n % | observes '(' QualifiedIdentList ')'\n %\n % ReturnTypes := '->' TypeExpr\n % | '->' '(' TypeExpr ( ',' TypeExpr )* ')'\n %\n % FuncBody := Block\n % | Foreign\n %\n:- pred parse_func(parsing.parser(Name, token_type),\n parse_type, parse_res({Name, ast_function}), tokens, tokens).\n:- mode parse_func(in(parsing.parser),\n in, out, in, out) is det.\n\nparse_func(ParseName, ParseType, Result, !Tokens) :-\n maybe_parse_func_export(Sharing, Entrypoint, !Tokens),\n parse_func_decl(ParseName, ParseType, DeclResult, !Tokens),\n ( DeclResult = ok({Name, Decl}),\n or([parse_map(func(Bs) = ast_body_block(Bs), parse_block),\n parse_foreign],\n BodyResult, !Tokens),\n ( BodyResult = ok(Body),\n Result = ok({Name, ast_function(Decl, Body, Sharing, Entrypoint)})\n ; BodyResult = error(C, G, E),\n Result = error(C, G, E)\n )\n ; DeclResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n % NestedFuncDefinition := 'func' Ident '(' ( Param ( ',' Param )* )? ')'\n % Uses* ReturnTypes? Block\n %\n % Param := ident : TypeExpr\n %\n % Uses := uses QualifiedIdent\n % | uses '(' QualifiedIdentList ')'\n % | observes QualifiedIdent\n % | observes '(' QualifiedIdentList ')'\n %\n % ReturnTypes := '->' TypeExpr\n % | '->' '(' TypeExpr ( ',' TypeExpr )* ')'\n %\n:- pred parse_nested_func(parse_res(ast_block_thing), tokens, tokens).\n:- mode parse_nested_func(out, in, out) is det.\n\nparse_nested_func(Result, !Tokens) :-\n parse_func_decl(parse_nq_name, parse_source, DeclResult, !Tokens),\n ( DeclResult = ok({Name, Decl}),\n parse_block(BodyResult, !Tokens),\n ( BodyResult = ok(Body),\n Result = ok(astbt_function(Name,\n ast_nested_function(Decl, Body)))\n ; BodyResult = error(C, G, E),\n Result = error(C, G, E)\n )\n ; DeclResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_func_decl(pred(parse_res(Name), tokens, tokens),\n parse_type, parse_res({Name, ast_function_decl}), tokens, tokens).\n:- mode parse_func_decl(pred(out, in, out) is det,\n in, out, in, out) is det.\n\nparse_func_decl(ParseName, ParseType, Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(func_, MatchFunc, !Tokens),\n ( MatchFunc = ok(_),\n ParseName(NameResult, !Tokens),\n parse_param_list(ParseType, ParamsResult, !Tokens),\n zero_or_more(parse_uses, ok(Uses), !Tokens),\n optional(parse_returns, ok(MaybeReturns), !Tokens),\n ( if\n NameResult = ok(Name),\n ParamsResult = ok(Params)\n then\n Result = ok({Name,\n ast_function_decl(Params, maybe_default([], MaybeReturns),\n condense(Uses), Context)})\n else\n Result = combine_errors_2(NameResult, ParamsResult)\n )\n ; MatchFunc = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_param_list(parse_type::in, parse_res(list(ast_param))::out,\n tokens::in, tokens::out) is det.\n\nparse_param_list(ParseType, Result, !Tokens) :-\n within(l_paren, zero_or_more_delimited(comma, parse_param(ParseType)),\n r_paren, Result, !Tokens).\n\n:- pred parse_param(parse_type::in, parse_res(ast_param)::out,\n tokens::in, tokens::out) is det.\n\nparse_param(parse_source, Result, !Tokens) :-\n parse_named_param(Result, !Tokens).\nparse_param(parse_interface, Result, !Tokens) :-\n or([parse_named_param, parse_unnamed_param], Result, !Tokens).\n\n:- pred parse_named_param(parse_res(ast_param)::out,\n tokens::in, tokens::out) is det.\n\nparse_named_param(Result, !Tokens) :-\n parse_ident_or_wildcard(NameOrWildResult, !Tokens),\n match_token(colon, ColonMatch, !Tokens),\n parse_type_expr(TypeResult, !Tokens),\n ( if\n NameOrWildResult = ok(NameOrWild),\n ColonMatch = ok(_),\n TypeResult = ok(Type)\n then\n Result = ok(ast_param(NameOrWild, Type))\n else\n Result = combine_errors_3(NameOrWildResult, ColonMatch, TypeResult)\n ).\n\n:- pred parse_unnamed_param(parse_res(ast_param)::out,\n tokens::in, tokens::out) is det.\n\nparse_unnamed_param(Result, !Tokens) :-\n parse_map(func(Type) = ast_param(wildcard, Type),\n parse_type_expr, Result, !Tokens).\n\n:- pred parse_returns(parse_res(list(ast_type_expr))::out,\n tokens::in, tokens::out) is det.\n\nparse_returns(Result, !Tokens) :-\n match_token(r_arrow, MatchRArrow, !Tokens),\n decl_list(parse_type_expr, ReturnTypesResult, !Tokens),\n ( if\n MatchRArrow = ok(_),\n ReturnTypesResult = ok(ReturnTypes)\n then\n Result = ok(ReturnTypes)\n else\n Result = combine_errors_2(MatchRArrow, ReturnTypesResult)\n ).\n\n:- pred parse_uses(parse_res(list(ast_uses))::out,\n tokens::in, tokens::out) is det.\n\nparse_uses(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n next_token(\"Uses or observes clause\", UsesObservesResult, !Tokens),\n ( UsesObservesResult = ok(token_and_string(UsesObserves, TokenString)),\n ( if\n ( UsesObserves = uses,\n UsesType = ut_uses\n ; UsesObserves = observes,\n UsesType = ut_observes\n )\n then\n decl_list(parse_q_name, ResourcesResult, !Tokens),\n Result = map((func(Rs) =\n map((func(R) = ast_uses(UsesType, R)), Rs)\n ), ResourcesResult)\n else\n Result = error(Context, TokenString, \"Uses or observes clause\")\n )\n ; UsesObservesResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n % Foreign := 'foreign' '(' Ident ')'\n %\n % A foreign code declration. Plasma will attempt to link the foreign\n % symbol named with the Ident.\n %\n:- pred parse_foreign(parse_res(ast_body)::out,\n tokens::in, tokens::out) is det.\n\nparse_foreign(Result, !Tokens) :-\n match_token(foreign, ForeignMatch, !Tokens),\n within(l_paren, match_token(ident), r_paren, MaybeName, !Tokens),\n ( if\n ForeignMatch = ok(_),\n MaybeName = ok(Name)\n then\n Result = ok(ast_body_foreign(Name))\n else\n Result = combine_errors_2(ForeignMatch, MaybeName)\n ).\n\n % Block := '{' ( Statment | Definition )* ReturnExpr? '}'\n % ReturnExpr := 'return' TupleExpr\n %\n % ReturnExpr is parsed here to avoid an ambiguity that could arise if\n % the expression it is returning is a match or if expression, since it\n % could also be the beginning of the following statement. By requiring\n % that the return statement is the last statement (which makes sense)\n % there can be no next statement and match/if is the expression being\n % returned. TODO: This could be a problem if we add yield statements,\n % which probably can be followed by other statements.\n %\n:- pred parse_block(parse_res(list(ast_block_thing))::out,\n tokens::in, tokens::out) is det.\n\nparse_block(Result, !Tokens) :-\n match_token(l_curly, MatchLCurly, !Tokens),\n zero_or_more_last_error(parse_block_thing, Stmts0Result, LastError,\n !Tokens),\n ( if\n MatchLCurly = ok(_),\n Stmts0Result = ok(Stmts0)\n then\n optional(parse_stmt_return, ok(MaybeReturn), !Tokens),\n match_token(r_curly, MatchRCurly, !Tokens),\n ( MatchRCurly = ok(_),\n ( MaybeReturn = yes(Return),\n Stmts = Stmts0 ++ [astbt_statement(Return)]\n ; MaybeReturn = no,\n Stmts = Stmts0\n ),\n Result = ok(Stmts)\n ; MatchRCurly = error(C, G, E),\n ( MaybeReturn = yes(_),\n Result = error(C, G, E)\n ; MaybeReturn = no,\n LastError = error(LastC, LastG, LastE),\n ( if LastC ^ c_line > C ^ c_line then\n % We partially parsed a statement above\n Result = error(LastC, LastG, LastE)\n else\n % We stopped parsing the zero_or_more_last_error above for\n % the same reason there's no return statement and no closing\n % brace.\n Result = error(C, G, \"statement or closing brace\")\n )\n )\n )\n else\n Result = combine_errors_2(MatchLCurly, Stmts0Result)\n ).\n\n:- pred parse_block_thing(parse_res(ast_block_thing)::out,\n tokens::in, tokens::out) is det.\n\nparse_block_thing(Result, !Tokens) :-\n or([ parse_map(func(S) = astbt_statement(S),\n parse_statement),\n parse_nested_func],\n Result, !Tokens).\n\n % Statement := 'var' Ident ( ',' Ident )+\n % | `match` Expr '{' Case+ '}'\n % | ITE\n % | CallInStmt\n % | IdentList '=' Expr\n % | Ident ArraySubscript '<=' Expr\n % | Definition\n %\n % CallInStmt := ExprPart '!'? '(' Expr ( , Expr )* ')'\n %\n % The '!' is an optional part of the grammer even though no sensible\n % program would omit it in this context (either it would be an error\n % because the callee uses a resource or the compiler would optimise the\n % call away).\n %\n % Case := Pattern '->' Block\n %\n % ITE := 'if' Expr Block else ElsePart\n % ElsePart := ITE | Block\n %\n:- pred parse_statement(parse_res(ast_statement)::out,\n tokens::in, tokens::out) is det.\n\nparse_statement(Result, !Tokens) :-\n or([ parse_stmt_match,\n parse_stmt_ite,\n parse_stmt_assign,\n parse_stmt_call,\n parse_stmt_var,\n parse_stmt_array_set],\n Result, !Tokens).\n\n:- pred parse_stmt_return(parse_res(ast_statement)::out,\n tokens::in, tokens::out) is det.\n\nparse_stmt_return(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(return, ReturnMatch, !Tokens),\n zero_or_more_delimited(comma, parse_expr, ok(Vals), !Tokens),\n Result = map((func(_) =\n ast_statement(s_return_statement(Vals), Context)),\n ReturnMatch).\n\n:- pred parse_stmt_match(parse_res(ast_statement)::out,\n tokens::in, tokens::out) is det.\n\nparse_stmt_match(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(match, MatchMatch, !Tokens),\n parse_expr(MExprResult, !Tokens),\n within_use_last_error(l_curly, one_or_more_last_error(parse_match_case),\n r_curly, CasesResult, !Tokens),\n ( if\n MatchMatch = ok(_),\n MExprResult = ok(MExpr),\n CasesResult = ok(Cases)\n then\n Result = ok(ast_statement(s_match_statement(MExpr, Cases), Context))\n else\n Result = combine_errors_3(MatchMatch, MExprResult, CasesResult)\n ).\n\n:- pred parse_match_case(parse_res(ast_match_case)::out,\n tokens::in, tokens::out) is det.\n\nparse_match_case(Result, !Tokens) :-\n parse_pattern(PatternResult, !Tokens),\n match_token(r_arrow, MatchArrow, !Tokens),\n parse_block(StmtsResult, !Tokens),\n ( if\n PatternResult = ok(Pattern),\n MatchArrow = ok(_),\n StmtsResult = ok(Stmts)\n then\n Result = ok(ast_match_case(Pattern, Stmts))\n else\n Result = combine_errors_3(PatternResult, MatchArrow, StmtsResult)\n ).\n\n:- pred parse_stmt_call(parse_res(ast_statement)::out,\n tokens::in, tokens::out) is det.\n\nparse_stmt_call(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n parse_call_in_stmt(CallResult, !Tokens),\n ( CallResult = ok(Call),\n Result = ok(ast_statement(s_call(Call), Context))\n ; CallResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n % Parse a call as it occurs within a statement.\n %\n:- pred parse_call_in_stmt(parse_res(ast_call_like)::out,\n tokens::in, tokens::out) is det.\n\nparse_call_in_stmt(Result, !Tokens) :-\n parse_expr_2(CalleeResult, !Tokens),\n optional(match_token(bang), ok(MaybeBang), !Tokens),\n % TODO: Use last error.\n within(l_paren, zero_or_more_delimited(comma, parse_expr), r_paren,\n ArgsResult, !Tokens),\n ( if\n CalleeResult = ok(Callee),\n ArgsResult = ok(Args)\n then\n ( MaybeBang = no,\n Result = ok(ast_call_like(Callee, Args))\n ; MaybeBang = yes(_),\n Result = ok(ast_bang_call(Callee, Args))\n )\n else\n Result = combine_errors_2(CalleeResult, ArgsResult)\n ).\n\n:- pred parse_stmt_var(parse_res(ast_statement)::out,\n tokens::in, tokens::out) is det.\n\nparse_stmt_var(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(var, VarMatch, !Tokens),\n match_token(ident, IdentResult, !Tokens),\n ( if\n VarMatch = ok(_),\n IdentResult = ok(Var)\n then\n Result = ok(ast_statement(s_var_statement(Var), Context))\n else\n Result = combine_errors_2(VarMatch, IdentResult)\n ).\n\n:- pred parse_stmt_assign(parse_res(ast_statement)::out,\n tokens::in, tokens::out) is det.\n\nparse_stmt_assign(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n one_or_more_delimited(comma, parse_pattern, LHSResult, !Tokens),\n parse_assigner(ValResult, !Tokens),\n ( if\n LHSResult = ok(LHSs),\n ValResult = ok(Val)\n then\n Result = ok(ast_statement(s_assign_statement(LHSs, Val), Context))\n else\n Result = combine_errors_2(LHSResult, ValResult)\n ).\n\n:- pred parse_assigner(parse_res(list(ast_expression))::out,\n tokens::in, tokens::out) is det.\n\nparse_assigner(Result, !Tokens) :-\n match_token(equals, EqualsMatch, !Tokens),\n one_or_more_delimited(comma, parse_expr, ValsResult, !Tokens),\n ( if\n EqualsMatch = ok(_)\n then\n Result = ValsResult\n else\n Result = combine_errors_2(EqualsMatch, ValsResult)\n ).\n\n:- pred parse_ident_or_wildcard(parse_res(var_or_wildcard(string))::out,\n tokens::in, tokens::out) is det.\n\nparse_ident_or_wildcard(Result, !Tokens) :-\n match_token(ident, ResultIdent, !.Tokens, TokensIdent),\n ( ResultIdent = ok(Ident),\n !:Tokens = TokensIdent,\n Result = ok(var(Ident))\n ; ResultIdent = error(C, G, E),\n match_token(underscore, ResultWildcard, !Tokens),\n ( ResultWildcard = ok(_),\n Result = ok(wildcard)\n ; ResultWildcard = error(_, _, _),\n Result = error(C, G, E)\n )\n ).\n\n:- pred parse_stmt_array_set(parse_res(ast_statement)::out,\n tokens::in, tokens::out) is det.\n\nparse_stmt_array_set(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(ident, NameResult, !Tokens),\n within(l_square, parse_expr, r_square, IndexResult, !Tokens),\n % TODO: Use := for array assignment.\n match_token(l_angle_equal, ArrowMatch, !Tokens),\n parse_expr(ValueResult, !Tokens),\n ( if\n NameResult = ok(Name),\n IndexResult = ok(Index),\n ArrowMatch = ok(_),\n ValueResult = ok(Value)\n then\n Result = ok(ast_statement(\n s_array_set_statement(Name, Index, Value), Context))\n else\n Result = combine_errors_4(NameResult, IndexResult, ArrowMatch,\n ValueResult)\n ).\n\n:- pred parse_stmt_ite(parse_res(ast_statement)::out,\n tokens::in, tokens::out) is det.\n\nparse_stmt_ite(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(if_, MatchIf, !Tokens),\n ( MatchIf = ok(_),\n parse_expr(CondResult, !Tokens),\n parse_block(ThenResult, !Tokens),\n match_token(else_, MatchElse, !Tokens),\n or([parse_stmt_ite_as_block, parse_block], ElseResult, !Tokens),\n ( if\n CondResult = ok(Cond),\n ThenResult = ok(Then),\n MatchElse = ok(_),\n ElseResult = ok(Else)\n then\n Result = ok(ast_statement(s_ite(Cond, Then, Else), Context))\n else\n Result = combine_errors_4(CondResult, ThenResult,\n MatchElse, ElseResult)\n )\n ; MatchIf = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_stmt_ite_as_block(parse_res(list(ast_block_thing))::out,\n tokens::in, tokens::out) is det.\n\nparse_stmt_ite_as_block(Result, !Tokens) :-\n parse_stmt_ite(Result0, !Tokens),\n Result = map((func(X) = [astbt_statement(X)]), Result0).\n\n % Expressions may be:\n %\n % A branch expression\n % Expr := 'match' Expr '{' Case+ '}'\n % | 'if' Expr 'then' Expr 'else' Expr\n % A binary and unary expressions\n % | Expr BinOp Expr\n % | UOp Expr\n % A call or construction\n % | ExprPart '!'? '(' Expr ( , Expr )* ')'\n % An array subscript\n % | ExprPart '[' Expr ']'\n % A higher precedence expression.\n % | ExprPart\n %\n % Which may be:\n % ExprPart := '(' Expr ')'\n % A list or array\n % | '[' ListExpr ']'\n % | '[:' TupleExpr? ':]'\n % A value:\n % | QualifiedIdent\n % A constant:\n % | const_str\n % | const_int\n %\n % ListExpr := e\n % | Expr ( ',' Expr )* ( ':' Expr )?\n %\n % Case := Pattern '->' TupleExpr\n %\n % The relative precedences of unary and binary operators is covered in\n % the reference manual\n % https://plasmalang.org/docs/plasma_ref.html#_expressions\n %\n:- pred parse_expr(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_expr(Result, !Tokens) :-\n or([parse_expr_match, parse_expr_if, parse_binary_expr(max_binop_level)],\n Result, !Tokens).\n\n:- pred parse_expr_match(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_expr_match(Result, !Tokens) :-\n match_token(match, MatchMatch, !Tokens),\n ( MatchMatch = ok(_),\n parse_expr(MatchExprResult, !Tokens),\n match_token(l_curly, MatchLCurly, !Tokens),\n one_or_more(parse_expr_match_case, CasesResult, !Tokens),\n match_token(r_curly, MatchRCurly, !Tokens),\n ( if\n MatchExprResult = ok(MatchExpr),\n MatchLCurly = ok(_),\n CasesResult = ok(Cases),\n MatchRCurly = ok(_)\n then\n Result = ok(e_match(MatchExpr, Cases))\n else\n Result = combine_errors_4(MatchExprResult, MatchLCurly,\n CasesResult, MatchRCurly)\n )\n ; MatchMatch = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_expr_match_case(parse_res(ast_expr_match_case)::out,\n tokens::in, tokens::out) is det.\n\nparse_expr_match_case(Result, !Tokens) :-\n parse_pattern(PatternResult, !Tokens),\n match_token(r_arrow, MatchArrow, !Tokens),\n one_or_more_delimited(comma, parse_expr, ExprsResult, !Tokens),\n ( if\n PatternResult = ok(Pattern),\n MatchArrow = ok(_),\n ExprsResult = ok(Exprs)\n then\n Result = ok(ast_emc(Pattern, Exprs))\n else\n Result = combine_errors_3(PatternResult, MatchArrow, ExprsResult)\n ).\n\n:- pred parse_expr_if(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_expr_if(Result, !Tokens) :-\n match_token(if_, MatchIf, !Tokens),\n ( MatchIf = ok(_),\n parse_expr(CondResult, !Tokens),\n match_token(then_, MatchThen, !Tokens),\n one_or_more_delimited(comma, parse_expr, ThenResult, !Tokens),\n match_token(else_, MatchElse, !Tokens),\n one_or_more_delimited(comma, parse_expr, ElseResult, !Tokens),\n ( if\n CondResult = ok(Cond),\n MatchThen = ok(_),\n ThenResult = ok(Then),\n MatchElse = ok(_),\n ElseResult = ok(Else)\n then\n Result = ok(e_if(Cond, Then, Else))\n else\n Result = combine_errors_5(CondResult, MatchThen, ThenResult,\n MatchElse, ElseResult)\n )\n ; MatchIf = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred operator_table(int, token_type, ast_bop).\n:- mode operator_table(in, in, out) is semidet.\n:- mode operator_table(out, out, out) is multi.\n\noperator_table(1, star, b_mul).\noperator_table(1, slash, b_div).\noperator_table(1, percent, b_mod).\noperator_table(2, plus, b_add).\noperator_table(2, minus, b_sub).\noperator_table(3, l_angle, b_lt).\noperator_table(3, r_angle, b_gt).\noperator_table(3, l_angle_equal, b_lteq).\noperator_table(3, r_angle_equal, b_gteq).\noperator_table(3, double_equal, b_eq).\noperator_table(3, bang_equal, b_neq).\noperator_table(4, and_, b_logical_and).\noperator_table(5, or_, b_logical_or).\noperator_table(6, double_plus, b_concat).\n\n:- func max_binop_level = int.\n\nmax_binop_level = Max :-\n solutions((pred(Level::out) is multi :- operator_table(Level, _, _)),\n Levels),\n Max = foldl((func(X, M) = (if X > M then X else M)), Levels, 1).\n\n:- pred parse_binary_expr(int::in, parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_binary_expr(Level, Result, !Tokens) :-\n parse_binary_expr_2(Level, ExprLResult, !Tokens),\n ( ExprLResult = ok(ExprL),\n parse_binary_expr_lassoc(Level, ExprL, Result, !Tokens)\n ; ExprLResult = error(_, _, _),\n Result = ExprLResult\n ).\n\n:- pred parse_binary_expr_lassoc(int::in, ast_expression::in,\n parse_res(ast_expression)::out, tokens::in, tokens::out) is det.\n\nparse_binary_expr_lassoc(Level, ExprL0, Result, !Tokens) :-\n BeforeOpTokens = !.Tokens,\n next_token(\"operator\", OpResult, !Tokens),\n ( if\n OpResult = ok(token_and_string(Op, _)),\n operator_table(Level, Op, EOp)\n then\n parse_binary_expr_2(Level, ExprNResult, !Tokens),\n ( ExprNResult = ok(ExprN),\n ExprL = e_b_op(ExprL0, EOp, ExprN),\n parse_binary_expr_lassoc(Level, ExprL, Result, !Tokens)\n ; ExprNResult = error(_, _, _),\n Result = ExprNResult\n )\n else\n !:Tokens = BeforeOpTokens,\n Result = ok(ExprL0)\n ).\n\n:- pred parse_binary_expr_2(int::in, parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_binary_expr_2(Level, Result, !Tokens) :-\n ( if Level > 0 then\n parse_binary_expr(Level - 1, ExprLResult, !Tokens),\n ( ExprLResult = ok(ExprL),\n BeforeOpTokens = !.Tokens,\n next_token(\"operator\", OpResult, !Tokens),\n ( if\n OpResult = ok(token_and_string(Op, _)),\n operator_table(Level, Op, EOp)\n then\n parse_binary_expr(Level - 1, ExprRResult, !Tokens),\n ( ExprRResult = ok(ExprR),\n Result = ok(e_b_op(ExprL, EOp, ExprR))\n ; ExprRResult = error(C, G, E),\n Result = error(C, G, E)\n )\n else\n Result = ok(ExprL),\n !:Tokens = BeforeOpTokens\n )\n ; ExprLResult = error(C, G, E),\n Result = error(C, G, E)\n )\n else\n parse_unary_expr(Result, !Tokens)\n ).\n\n:- pred parse_unary_expr(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_unary_expr(Result, !Tokens) :-\n StartTokens = !.Tokens,\n next_token(\"expression\", TokenResult, !Tokens),\n ( TokenResult = ok(token_and_string(Token, _)),\n ( if\n ( Token = minus,\n UOp = u_minus\n ; Token = not_,\n UOp = u_not\n )\n then\n parse_unary_expr(ExprResult, !Tokens),\n Result = map((func(E) = e_u_op(UOp, E)), ExprResult)\n else\n !:Tokens = StartTokens,\n parse_expr_1(Result, !Tokens)\n )\n ; TokenResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n % This precidence level covers calls and array subscriptions.\n %\n:- pred parse_expr_1(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_expr_1(Result, !Tokens) :-\n parse_expr_2(Part1Result0, !Tokens),\n ( Part1Result0 = ok(Part1),\n parse_expr_part_2(Part1, Result, !Tokens)\n ; Part1Result0 = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_expr_part_2(ast_expression::in, parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_expr_part_2(Part1, Result, !Tokens) :-\n Part1Tokens = !.Tokens,\n next_token(\"Call arguments or array subscript\", NextResult,\n !Tokens),\n ( NextResult = ok(token_and_string(Next, _)),\n ( if\n (\n Next = l_paren,\n require_det (\n parse_call_part2(Part1, Result1, !Tokens)\n )\n ;\n Next = bang,\n require_det (\n match_token(l_paren, ParenResult, !Tokens),\n ( ParenResult = ok(_),\n parse_call_part2(Part1, Result0, !Tokens),\n Result1 = map(make_bang_call, Result0)\n ; ParenResult = error(C, G, E),\n Result1 = error(C, G, E)\n )\n )\n ;\n Next = l_square,\n require_det (\n parse_array_subscript_part2(Part1, Result1, !Tokens)\n )\n )\n then\n ( Result1 = ok(Expr),\n parse_expr_part_2(Expr, Result, !Tokens)\n ; Result1 = error(_, _, _),\n !:Tokens = Part1Tokens,\n Result = ok(Part1)\n )\n else\n !:Tokens = Part1Tokens,\n Result = ok(Part1)\n )\n ; NextResult = error(_, _, _),\n !:Tokens = Part1Tokens,\n Result = ok(Part1)\n ).\n\n:- pred parse_expr_2(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_expr_2(Result, !Tokens) :-\n or([ parse_const_expr,\n within(l_paren, parse_expr, r_paren),\n within(l_square, parse_list_expr, r_square),\n parse_array_expr,\n parse_expr_symbol\n ], Result, !Tokens).\n\n:- pred parse_const_expr(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_const_expr(Result, !Tokens) :-\n ( if parse_string(ok(String), !Tokens) then\n Result = ok(e_const(c_string(String)))\n else if parse_number(ok(Num), !Tokens) then\n Result = ok(e_const(c_number(Num)))\n else\n get_context(!.Tokens, Context),\n Result = error(Context, \"\", \"expression\")\n ).\n\n:- pred parse_array_expr(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_array_expr(Result, !Tokens) :-\n within(l_square_colon, zero_or_more_delimited(comma, parse_expr),\n r_square_colon, Result0, !Tokens),\n Result = map((func(Exprs) = e_array(Exprs)), Result0).\n\n:- pred parse_string(parse_res(string)::out, tokens::in, tokens::out)\n is det.\n\nparse_string(Result, !Tokens) :-\n match_token(string, Result0, !Tokens),\n Result = map(unescape_string, Result0).\n\n:- pred parse_number(parse_res(int)::out, tokens::in, tokens::out) is det.\n\nparse_number(Result, !Tokens) :-\n optional(match_token(minus), ok(MaybeMinus), !Tokens),\n match_token(number, Result0, !Tokens),\n ( MaybeMinus = yes(_),\n Convert = (func(N) = string.det_to_int(N) * -1)\n ; MaybeMinus = no,\n Convert = string.det_to_int\n ),\n Result = map(Convert, Result0).\n\n:- pred parse_list_expr(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_list_expr(Result, !Tokens) :-\n StartTokens = !.Tokens,\n one_or_more_delimited(comma, parse_expr, HeadsResult, !Tokens),\n ( HeadsResult = ok(Heads),\n BeforeBarTokens = !.Tokens,\n match_token(bar, MatchBar, !Tokens),\n ( MatchBar = ok(_),\n parse_expr(TailResult, !Tokens),\n ( TailResult = ok(Tail),\n Result = ok(make_cons_list(Heads, Tail))\n ; TailResult = error(C, G, E),\n Result = error(C, G, E)\n )\n ; MatchBar = error(_, _, _),\n !:Tokens = BeforeBarTokens,\n Result = ok(make_cons_list(Heads, e_const(c_list_nil)))\n )\n ; HeadsResult = error(_, _, _),\n !:Tokens = StartTokens,\n Result = ok(e_const(c_list_nil))\n ).\n\n:- pred parse_expr_symbol(parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_expr_symbol(Result, !Tokens) :-\n parse_q_name(QNameResult, !Tokens),\n Result = map((func(Name) = e_symbol(Name)), QNameResult).\n\n:- pred parse_call_part2(ast_expression::in, parse_res(ast_expression)::out,\n tokens::in, tokens::out) is det.\n\nparse_call_part2(Callee, Result, !Tokens) :-\n zero_or_more_delimited(comma, parse_expr, ok(Args), !Tokens),\n match_token(r_paren, MatchParen, !Tokens),\n ( MatchParen = ok(_),\n Result = ok(e_call_like(ast_call_like(Callee, Args)))\n ; MatchParen = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_array_subscript_part2(ast_expression::in,\n parse_res(ast_expression)::out, tokens::in, tokens::out) is det.\n\nparse_array_subscript_part2(Expr, Result, !Tokens) :-\n parse_expr(SubscriptResult, !Tokens),\n match_token(r_square, MatchClose, !Tokens),\n ( if\n SubscriptResult = ok(Subscript),\n MatchClose = ok(_)\n then\n Result = ok(e_b_op(Expr, b_array_subscript, Subscript))\n else\n Result = combine_errors_2(SubscriptResult, MatchClose)\n ).\n\n % Pattern := Number\n % | QualifiedIdent ( '(' Pattern ',' ( Pattern ',' )+ ')' )?\n %\n:- pred parse_pattern(parse_res(ast_pattern)::out,\n tokens::in, tokens::out) is det.\n\nparse_pattern(Result, !Tokens) :-\n or([ parse_constr_pattern,\n parse_list_pattern,\n parse_number_pattern,\n parse_wildcard_pattern,\n parse_var_pattern\n ], Result, !Tokens).\n\n:- pred parse_constr_pattern(parse_res(ast_pattern)::out,\n tokens::in, tokens::out) is det.\n\nparse_constr_pattern(Result, !Tokens) :-\n parse_q_name(Result0, !Tokens),\n ( Result0 = ok(Symbol),\n optional(within(l_paren, one_or_more_delimited(comma, parse_pattern),\n r_paren),\n ok(MaybeArgs), !Tokens),\n ( MaybeArgs = yes(Args),\n Result = ok(p_constr(Symbol, Args))\n ; MaybeArgs = no,\n Result = ok(p_symbol(Symbol))\n )\n ; Result0 = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_list_pattern(parse_res(ast_pattern)::out,\n tokens::in, tokens::out) is det.\n\nparse_list_pattern(Result, !Tokens) :-\n within(l_square, parse_list_pattern_2, r_square, Result0, !Tokens),\n Result = map(id, Result0).\n\n:- pred parse_list_pattern_2(parse_res(ast_pattern)::out,\n tokens::in, tokens::out) is det.\n\nparse_list_pattern_2(Result, !Tokens) :-\n ( if peek_token(!.Tokens, yes(r_square)) then\n Result = ok(p_list_nil)\n else\n one_or_more_delimited(comma, parse_pattern, HeadsResult, !Tokens),\n ( HeadsResult = ok(Heads),\n BeforeBarTokens = !.Tokens,\n match_token(bar, MatchBar, !Tokens),\n ( MatchBar = ok(_),\n parse_pattern(TailResult, !Tokens),\n ( TailResult = ok(Tail),\n Result = ok(make_p_list_cons(Heads, Tail))\n ; TailResult = error(C, G, E),\n Result = error(C, G, E)\n )\n ; MatchBar = error(_, _, _),\n !:Tokens = BeforeBarTokens,\n Result = ok(make_p_list_cons(Heads, p_list_nil))\n )\n ; HeadsResult = error(C, G, E),\n Result = error(C, G, E)\n )\n ).\n\n:- func make_p_list_cons(list(ast_pattern), ast_pattern) = ast_pattern.\n\nmake_p_list_cons([], Tail) = Tail.\nmake_p_list_cons([Head | Heads], Tail) =\n p_list_cons(Head, make_p_list_cons(Heads, Tail)).\n\n:- pred parse_number_pattern(parse_res(ast_pattern)::out,\n tokens::in, tokens::out) is det.\n\nparse_number_pattern(Result, !Tokens) :-\n parse_number(Result0, !Tokens),\n Result = map((func(N) = p_number(N)), Result0).\n\n:- pred parse_wildcard_pattern(parse_res(ast_pattern)::out,\n tokens::in, tokens::out) is det.\n\nparse_wildcard_pattern(Result, !Tokens) :-\n match_token(underscore, Result0, !Tokens),\n Result = map((func(_) = p_wildcard), Result0).\n\n:- pred parse_var_pattern(parse_res(ast_pattern)::out,\n tokens::in, tokens::out) is det.\n\nparse_var_pattern(Result, !Tokens) :-\n match_token(var, MatchVar, !Tokens),\n match_token(ident, Result0, !Tokens),\n ( if\n MatchVar = ok(_),\n Result0 = ok(S)\n then\n Result = ok(p_var(S))\n else\n Result = combine_errors_2(MatchVar, Result0)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred maybe_parse_func_export(sharing::out, is_entrypoint::out,\n tokens::in, tokens::out) is det.\n\nmaybe_parse_func_export(Sharing, IsEntrypoint, !Tokens) :-\n parse_export(Sharing0, !Tokens),\n optional(match_token(entrypoint), ok(MaybeEntrypoint), !Tokens),\n ( MaybeEntrypoint = yes(_),\n ( Sharing0 = s_private,\n % the export keyword might have come after entrypoint, so check\n % again.\n parse_export(Sharing, !Tokens)\n ; Sharing0 = s_public,\n Sharing = s_public\n ),\n IsEntrypoint = is_entrypoint\n ; MaybeEntrypoint = no,\n IsEntrypoint = not_entrypoint,\n Sharing = Sharing0\n ).\n\n:- pred parse_export_opaque(sharing_opaque::out,\n tokens::in, tokens::out) is det.\n\nparse_export_opaque(Result, !Tokens) :-\n optional(match_token(export), ok(Export), !Tokens),\n ( Export = yes(_),\n optional(match_token(opaque), ok(Opaque), !Tokens),\n ( Opaque = yes(_),\n Result = so_public_opaque\n ; Opaque = no,\n Result = so_public\n )\n ; Export = no,\n Result = so_private\n ).\n\n:- pred parse_export(sharing::out, tokens::in, tokens::out) is det.\n\nparse_export(Sharing, !Tokens) :-\n optional(match_token(export), ok(MaybeExport), !Tokens),\n ( MaybeExport = yes(_),\n Sharing = s_public\n ; MaybeExport = no,\n Sharing = s_private\n ).\n\n%-----------------------------------------------------------------------%\n\n % Pragma := 'pragma' Ident ('(' ( PragmaArg PragmaArgs )? ')')\n %\n % PragmaArgs := ',' PragmaArg PragmaArgs\n % | empty\n %\n % PragmaArg := String\n %\n:- pred parse_pragma(parse_res(ast_entry)::out, tokens::in, tokens::out)\n is det.\n\nparse_pragma(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(pragma_, MatchPragma, !Tokens),\n match_token(ident, MatchIdent, !Tokens),\n within(l_paren, zero_or_more_delimited(comma, parse_pragma_arg),\n r_paren, MatchArgs, !Tokens),\n ( if\n MatchPragma = ok(_),\n MatchIdent = ok(Ident),\n MatchArgs = ok(Args)\n then\n Result = ok(ast_pragma(ast_pragma(Ident, Args, Context)))\n else\n Result = combine_errors_3(MatchPragma, MatchIdent, MatchArgs)\n ).\n\n:- pred parse_pragma_arg(parse_res(ast_pragma_arg)::out,\n tokens::in, tokens::out) is det.\n\nparse_pragma_arg(Result, !Tokens) :-\n parse_string(StringRes, !Tokens),\n ( StringRes = ok(String),\n Result = ok(ast_pragma_arg(String))\n ; StringRes = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- pred parse_plasma_interface(\n pred(parse_res(E), tokens, tokens),\n tokens, result(ast(E), read_src_error)).\n:- mode parse_plasma_interface(\n pred(out, in, out) is det,\n in, out) is det.\n\nparse_plasma_interface(ParseEntry, !.Tokens, Result) :-\n get_context(!.Tokens, Context),\n match_token(module_, ModuleMatch, !Tokens),\n parse_q_name(NameResult, !Tokens),\n zero_or_more_last_error(ParseEntry, ok(Items), LastError,\n !Tokens),\n ( if\n ModuleMatch = ok(_),\n NameResult = ok(Name)\n then\n ( !.Tokens = [],\n Result = ok(ast(Name, Context, Items))\n ; !.Tokens = [token(Tok, _, TokCtxt) | _],\n LastError = error(LECtxt, Got, Expect),\n ( if compare((<), LECtxt, TokCtxt) then\n Result = return_error(TokCtxt,\n rse_parse_junk_at_end(string(Tok)))\n else\n Result = return_error(LECtxt, rse_parse_error(Got, Expect))\n )\n )\n else\n Result0 = combine_errors_2(ModuleMatch, NameResult) `with_type`\n parse_res(unit),\n ( Result0 = error(C, G, E),\n Result = return_error(C, rse_parse_error(G, E))\n ; Result0 = ok(_),\n unexpected($file, $pred, \"ok/1, expecting error/1\")\n )\n ).\n\n:- pred parse_interface_entry(parse_res(ast_interface_entry)::out,\n tokens::in, tokens::out) is det.\n\nparse_interface_entry(Result, !Tokens) :-\n or([parse_map(func({N, T}) = asti_resource(N, T),\n parse_resource_interface),\n parse_map(func({N, T}) = asti_type(N, T),\n parse_type(parse_q_name)),\n parse_map(func({N, D}) = asti_function(N, D),\n parse_func_decl(parse_q_name, parse_interface))\n ], Result, !Tokens).\n\n:- pred parse_typeres_entry(parse_res(ast_typeres_entry)::out,\n tokens::in, tokens::out) is det.\n\nparse_typeres_entry(Result, !Tokens) :-\n or([parse_map(func(N) = asti_resource_abs(N), parse_abs_thing(resource)),\n parse_map(func({N, T}) = asti_type_abs(N, type_arity(T)),\n parse_type(parse_q_name))\n ], Result, !Tokens).\n\n:- pred parse_abs_thing(token_type::in, parse_res(q_name)::out,\n tokens::in, tokens::out) is det.\n\nparse_abs_thing(Token, Result, !Tokens) :-\n match_token(Token, ResourceMatch, !Tokens),\n ( ResourceMatch = ok(_),\n parse_q_name(Result, !Tokens)\n ; ResourceMatch = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n % A comma-seperated list with parens or a singleton item.\n %\n % This is used for lists where a comma in the list could either be the\n % end of the whole list and the legal beginning of something else, or\n % parens can be used to allow a list here. This can be used for things\n % like the return types of function types when the function type is in\n % list of its own.\n %\n:- pred decl_list(parsing.parser(R, token_type)::in(parsing.parser),\n parse_res(list(R))::out, tokens::in, tokens::out) is det.\n\ndecl_list(Parser, Result, !Tokens) :-\n ( if peek_token(!.Tokens, yes(l_paren)) then\n within(l_paren, one_or_more_delimited(comma, Parser), r_paren,\n Result, !Tokens)\n else\n Parser(Result0, !Tokens),\n Result = map((func(R) = [R]), Result0)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func make_cons_list(list(ast_expression), ast_expression) =\n ast_expression.\n\nmake_cons_list([], Tail) = Tail.\nmake_cons_list([X | Xs], Tail) = List :-\n List0 = make_cons_list(Xs, Tail),\n List = e_b_op(X, b_list_cons, List0).\n\n:- func make_bang_call(ast_expression) = ast_expression.\n\nmake_bang_call(Expr0) = Expr :-\n ( if Expr0 = e_call_like(ast_call_like(Callee, Args)) then\n Expr = e_call_like(ast_bang_call(Callee, Args))\n else\n unexpected($file, $pred, \"Not a call\")\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/parse_util.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module parse_util.\n%\n% Parsing and lexing utils.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module io.\n:- import_module list.\n:- import_module maybe.\n\n:- import_module lex.\n:- import_module parsing.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- type parser(T, R) == pred(list(token(T)), result(R, read_src_error)).\n:- inst parser == ( pred(in, out) is det ).\n\n:- type check_token(T) == pred(token(T), maybe(read_src_error)).\n:- inst check_token == ( pred(in, out) is det ).\n\n % parse_file(FileName, Lexemes, IgnoreToken, CheckToken, Parser, Result),\n %\n:- pred parse_file(string::in,\n list(lexeme(lex_token(T)))::in, lex.ignore_pred(T)::in(ignore_pred),\n check_token(T)::in(check_token),\n parse_util.parser(T, R)::in(parse_util.parser),\n result(R, read_src_error)::out, io::di, io::uo) is det.\n\n % parse_file(FileName, Lexemes, IgnoreToken, Parser, Result),\n %\n:- pred parse_file(string::in,\n list(lexeme(lex_token(T)))::in, lex.ignore_pred(T)::in(ignore_pred),\n parse_util.parser(T, R)::in(parse_util.parser),\n result(R, read_src_error)::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n\n % A token during lexical analysis. Context information is added later\n % and the pzt_token type is then used.\n %\n:- type lex_token(T)\n ---> lex_token(T, string).\n\n:- func return(T) = token_creator(lex_token(T)).\n\n%-----------------------------------------------------------------------%\n\n:- type read_src_error\n ---> rse_io_error(string)\n ; rse_tokeniser_error(string)\n ; rse_tokeniser_greedy_comment\n ; rse_tokeniser_starstarslash_comment\n ; rse_parse_error(pe_got :: string, pe_expect :: string)\n ; rse_parse_junk_at_end(string).\n\n:- instance error(read_src_error).\n\n%-----------------------------------------------------------------------%\n\n:- pred tokenize(text_input_stream::in, lexer(lex_token(T), string)::in,\n ignore_pred(T)::in(ignore_pred), check_token(T)::in(check_token),\n string::in,\n result(list(token(T)), read_src_error)::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module char.\n:- import_module cord.\n:- import_module int.\n:- import_module string.\n\n:- import_module context.\n:- import_module util.pretty.\n\n%-----------------------------------------------------------------------%\n\nparse_file(Filename, Lexemes, IgnoreTokens, CheckToken, Parse, Result, !IO) :-\n io.open_input(Filename, OpenResult, !IO),\n ( OpenResult = ok(File),\n Lexer = lex.init(Lexemes, lex.read_from_string, ignore_nothing),\n tokenize(File, Lexer, IgnoreTokens, CheckToken, Filename,\n TokensResult, !IO),\n io.close_input(File, !IO),\n ( TokensResult = ok(Tokens),\n Parse(Tokens, Result0),\n ( Result0 = ok(Node),\n Result = ok(Node)\n ; Result0 = errors(Errors),\n Result = errors(Errors)\n )\n ; TokensResult = errors(Errors),\n Result = errors(Errors)\n )\n ; OpenResult = error(IOError),\n Result = return_error(context(Filename),\n rse_io_error(error_message(IOError)))\n ).\n\nparse_file(Filename, Lexemes, IgnoreTokens, Parse, Result, !IO) :-\n parse_file(Filename, Lexemes, IgnoreTokens, check_ok, Parse, Result,\n !IO).\n\n:- pred check_ok(T::in, maybe(read_src_error)::out) is det.\n\ncheck_ok(_, no).\n\n%-----------------------------------------------------------------------%\n\nreturn(T) = (func(S) = lex_token(T, S)).\n\n%-----------------------------------------------------------------------%\n\n:- instance error(read_src_error) where [\n func(error_or_warning/1) is rse_error_or_warning,\n pretty(_, E, rse_pretty(E), [])\n].\n\n:- func rse_error_or_warning(read_src_error) = error_or_warning.\n\nrse_error_or_warning(rse_io_error(_)) = error.\nrse_error_or_warning(rse_tokeniser_error(_)) = error.\nrse_error_or_warning(rse_tokeniser_greedy_comment) = error.\nrse_error_or_warning(rse_tokeniser_starstarslash_comment) = warning.\nrse_error_or_warning(rse_parse_error(_, _)) = error.\nrse_error_or_warning(rse_parse_junk_at_end(_)) = error.\n\n:- func rse_pretty(read_src_error) = list(pretty).\n\nrse_pretty(rse_io_error(Message)) = p_words(Message).\nrse_pretty(rse_tokeniser_error(Message)) =\n p_words(\"Tokenizer error,\") ++ p_spc_nl ++ p_words(Message).\nrse_pretty(rse_tokeniser_greedy_comment) =\n p_words(\"The tokeniser got confused, \" ++\n \"until we improve it please don't end comments with **/\").\nrse_pretty(rse_tokeniser_starstarslash_comment) =\n p_words(\"The tokeniser can get confused, \" ++\n \"until we improve it please don't end comments with **/\").\nrse_pretty(rse_parse_error(Got, Expected)) =\n p_words(\"Parse error, read\") ++ p_spc_nl ++\n [p_str(Got)] ++ p_spc_nl ++\n [p_str(\"expected\")] ++ p_spc_nl ++\n [p_str(Expected)].\nrse_pretty(rse_parse_junk_at_end(Got)) =\n p_words(\"Parse error: junk at end of input:\") ++ p_spc_nl ++\n [p_str(Got)].\n\n%-----------------------------------------------------------------------%\n\ntokenize(File, Lexer, IgnoreTokens, CheckToken, Filename, MaybeTokens, !IO) :-\n io.read_file_as_string(File, ReadResult, !IO),\n ( ReadResult = ok(String0),\n copy(String0, String),\n tokenize_string(Filename, Lexer, IgnoreTokens, CheckToken, String,\n MaybeTokens)\n ; ReadResult = error(_, IOError),\n MaybeTokens = return_error(context(Filename, -1, -1),\n rse_io_error(error_message(IOError)))\n ).\n\n:- pred tokenize_string(string::in, lexer(lex_token(T), string)::in,\n ignore_pred(T)::in(ignore_pred), check_token(T)::in(check_token),\n string::di, result(list(token(T)), read_src_error)::out) is det.\n\ntokenize_string(Filename, Lexer, IgnoreToken, CheckToken, String,\n MaybeTokens) :-\n LS0 = lex.start(Lexer, String),\n tokenize_string(IgnoreToken, CheckToken, Filename, pos(1, 1), [],\n init, MaybeTokens, LS0, LS),\n _ = lex.stop(LS).\n\n:- pred tokenize_string(ignore_pred(T)::in(ignore_pred),\n check_token(T)::in(check_token), string::in, pos::in, list(token(T))::in,\n errors(read_src_error)::in,\n result(list(token(T)), read_src_error)::out,\n lexer_state(lex_token(T), string)::di,\n lexer_state(lex_token(T), string)::uo) is det.\n\ntokenize_string(IgnoreTokens, CheckToken, Filename, Pos0, RevTokens0,\n !.Errors, MaybeTokens, !LS) :-\n pos(Line, Col) = Pos0,\n Context = context(Filename, Line, Col),\n lex.read(MaybeToken, !LS),\n ( MaybeToken = ok(lex_token(Token, String)),\n advance_position(String, Pos0, Pos),\n TAC = token(Token, String, Context),\n CheckToken(TAC, CheckRes),\n ( CheckRes = no\n ; CheckRes = yes(Error),\n add_error(Context, Error, !Errors)\n ),\n ( if IgnoreTokens(Token) then\n RevTokens = RevTokens0\n else\n RevTokens = [TAC | RevTokens0]\n ),\n tokenize_string(IgnoreTokens, CheckToken, Filename, Pos, RevTokens,\n !.Errors, MaybeTokens, !LS)\n ; MaybeToken = eof,\n ( if is_empty(!.Errors) then\n MaybeTokens = ok(reverse(RevTokens0))\n else\n MaybeTokens = errors(!.Errors)\n )\n ; MaybeToken = error(Message, _Line),\n MaybeTokens = return_error(Context, rse_tokeniser_error(Message))\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type pos\n ---> pos(\n p_line :: int,\n p_col :: int\n ).\n\n:- pred advance_position(string::in, pos::in, pos::out) is det.\n\nadvance_position(String, !Pos) :-\n foldl(advance_position_char, String, !Pos).\n\n:- pred advance_position_char(char::in, pos::in, pos::out) is det.\n\nadvance_position_char(Char, !Pos) :-\n ( if Char = '\\n' ; Char = '\\r' then\n !:Pos = pos(!.Pos ^ p_line + 1, 1)\n else\n !:Pos = pos(!.Pos ^ p_line, !.Pos ^ p_col + 1)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred ignore_nothing(Token::in) is semidet.\n\nignore_nothing(_) :- semidet_false.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/parsing.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module parsing.\n%\n% Parsing utils.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module list.\n:- import_module maybe.\n:- import_module unit.\n\n:- import_module context.\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\n:- type token(T)\n ---> token(\n t_terminal :: T,\n t_data :: string,\n t_context :: context\n ).\n\n:- type parse_res(R)\n ---> ok(R)\n ; error(context, pe_got :: string, pe_expect :: string).\n\n:- inst res_ok for parse_res/1\n ---> ok(ground).\n\n:- inst res_error for parse_res/1\n ---> error(ground, ground, ground).\n\n:- type parser(R, T) == pred(parse_res(R), list(token(T)), list(token(T))).\n:- inst parser == ( pred(out, in, out) is det ).\n\n:- type parser_last_error(R, T) == pred(parse_res(R), parse_res(unit),\n list(token(T)), list(token(T))).\n:- inst parser_last_error == ( pred(out, out(res_error), in, out) is det ).\n\n%-----------------------------------------------------------------------%\n\n:- pred optional(parser(R, T)::in(parser),\n parse_res(maybe(R))::out(res_ok),\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred optional_last_error(parser(R, T)::in(parser),\n parse_res(maybe(R))::out(res_ok),\n parse_res(unit)::out(res_error),\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred zero_or_more(parser(R, T)::in(parser),\n parse_res(list(R))::out(res_ok),\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred zero_or_more_last_error(parser(R, T)::in(parser),\n parse_res(list(R))::out(res_ok),\n parse_res(unit)::out(res_error),\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred zero_or_more_delimited(T::in, parser(R, T)::in(parser),\n parse_res(list(R))::out(res_ok),\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred one_or_more(parser(R, T)::in(parser),\n parse_res(list(R))::out,\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred one_or_more_last_error(parser(R, T)::in(parser),\n parse_res(list(R))::out,\n parse_res(unit)::out(res_error),\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred one_or_more_delimited(T::in, parser(R, T)::in(parser),\n parse_res(list(R))::out,\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred or(list(parser(R, T))::in(list(parser)), parse_res(R)::out,\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred within(T::in, parser(R, T)::in(parser), T::in,\n parse_res(R)::out, list(token(T))::in, list(token(T))::out) is det.\n\n:- pred within_use_last_error(T::in,\n parser_last_error(R, T)::in(parser_last_error),\n T::in, parse_res(R)::out, list(token(T))::in, list(token(T))::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- pred parse_map(func(A) = B, parser(A, T), parse_res(B),\n list(token(T)), list(token(T))).\n:- mode parse_map(func(in) = out is det, in(parser), out, in, out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- func combine_errors_2(parse_res(R1), parse_res(R2)) = parse_res(R).\n\n:- func combine_errors_3(parse_res(R1), parse_res(R2), parse_res(R3)) =\n parse_res(R).\n\n:- func combine_errors_4(parse_res(R1), parse_res(R2), parse_res(R3),\n parse_res(R4)) =\n parse_res(R).\n\n:- func combine_errors_5(parse_res(R1), parse_res(R2), parse_res(R3),\n parse_res(R4), parse_res(R5)) =\n parse_res(R).\n\n:- func combine_errors_6(parse_res(R1), parse_res(R2), parse_res(R3),\n parse_res(R4), parse_res(R5), parse_res(R6)) =\n parse_res(R).\n\n:- func latest_error(parse_res(R1), parse_res(R2)) = parse_res(R).\n:- mode latest_error(in, in(res_error)) = out(res_error) is det.\n:- mode latest_error(in(res_error), in) = out(res_error) is det.\n\n:- func map(func(X) = Y, parse_res(X)) = parse_res(Y).\n\n%-----------------------------------------------------------------------%\n\n:- pred match_token(T::in, parse_res(string)::out,\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred match_tokens(list(T)::in, parse_res(unit)::out,\n list(token(T))::in, list(token(T))::out) is det.\n\n:- type token_and_string(T)\n ---> token_and_string(T, string).\n\n:- pred next_token(string::in, parse_res(token_and_string(T))::out,\n list(token(T))::in, list(token(T))::out) is det.\n\n:- pred peek_token(list(token(T))::in, maybe(T)::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- pred get_context(list(token(T))::in, context::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- typeclass ident_parsing(T) where [\n func ident_ = T,\n func period_ = T\n].\n\n:- pred parse_nq_name(parse_res(nq_name)::out,\n list(token(T))::in, list(token(T))::out) is det <= ident_parsing(T).\n\n:- pred parse_q_name(parse_res(q_name)::out,\n list(token(T))::in, list(token(T))::out) is det <= ident_parsing(T).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module require.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\noptional(Parse, Result, !Tokens) :-\n optional_last_error(Parse, Result, _, !Tokens).\n\noptional_last_error(Parse, Result, LastError, !Tokens) :-\n StartTokens = !.Tokens,\n Parse(Result0, !Tokens),\n ( Result0 = ok(X),\n Result = ok(yes(X)),\n LastError = error(nil_context, \"\", \"\")\n ; Result0 = error(C, G, E),\n !:Tokens = StartTokens,\n Result = ok(no),\n LastError = error(C, G, E)\n ).\n\n%-----------------------------------------------------------------------%\n\nzero_or_more(Parse, Result, !Tokens) :-\n zero_or_more_last_error(Parse, Result, _, !Tokens).\n\nzero_or_more_last_error(Parse, Result, LastError, !Tokens) :-\n StartTokens = !.Tokens,\n Parse(ResultX, !Tokens),\n ( ResultX = ok(X),\n zero_or_more_last_error(Parse, ResultXS, LastError, !Tokens),\n ResultXS = ok(XS),\n Result = ok([X | XS])\n ; ResultX = error(C, G, E),\n !:Tokens = StartTokens,\n Result = ok([]),\n LastError = error(C, G, E)\n ).\n\nzero_or_more_delimited(Delim, Parse, Result, !Tokens) :-\n Parse(ResultX, !.Tokens, Tokens0),\n ( ResultX = ok(X),\n !:Tokens = Tokens0,\n delimited_list(Delim, Parse, ok(Xs), !Tokens),\n Result = ok([X | Xs])\n ; ResultX = error(_, _, _),\n Result = ok([])\n ).\n\none_or_more(Parse, Result, !Tokens) :-\n StartTokens = !.Tokens,\n Parse(ResultX, !Tokens),\n ( ResultX = ok(X),\n zero_or_more(Parse, ok(XS), !Tokens),\n Result = ok([X | XS])\n ; ResultX = error(C, G, E),\n !:Tokens = StartTokens,\n Result = error(C, G, E)\n ).\n\none_or_more_last_error(Parse, Result, LastError, !Tokens) :-\n StartTokens = !.Tokens,\n Parse(ResultX, !Tokens),\n ( ResultX = ok(X),\n zero_or_more_last_error(Parse, ResultXS, LastError, !Tokens),\n ResultXS = ok(XS),\n Result = ok([X | XS])\n ; ResultX = error(C, G, E),\n !:Tokens = StartTokens,\n Result = error(C, G, E),\n LastError = error(C, G, E)\n ).\n\none_or_more_delimited(Delim, Parse, Result, !Tokens) :-\n StartTokens = !.Tokens,\n Parse(ResultX, !Tokens),\n ( ResultX = ok(X),\n delimited_list(Delim, Parse, ok(XS), !Tokens),\n Result = ok([X | XS])\n ; ResultX = error(C, G, E),\n !:Tokens = StartTokens,\n Result = error(C, G, E)\n ).\n\n:- pred delimited_list(T::in, parser(R, T)::in(parser),\n parse_res(list(R))::out(res_ok),\n list(token(T))::in, list(token(T))::out) is det.\n\ndelimited_list(Delim, Parse, Result, !Tokens) :-\n match_token(Delim, DelimMatch, !.Tokens, Tokens0),\n Parse(ResultX, Tokens0, Tokens1),\n ( if\n DelimMatch = ok(_),\n ResultX = ok(X)\n then\n !:Tokens = Tokens1,\n delimited_list(Delim, Parse, ok(Xs), !Tokens),\n Result = ok([X | Xs])\n else\n Result = ok([])\n ).\n\n%-----------------------------------------------------------------------%\n\nor(Parsers, Result, !Tokens) :-\n or_loop(error(nil_context, \"\", \"\"), Parsers, Result, !Tokens).\n\n:- pred or_loop(parse_res(R)::in(res_error),\n list(parser(R, T))::in(list(parser)), parse_res(R)::out,\n list(token(T))::in, list(token(T))::out) is det.\n\nor_loop(PrevError, [], PrevError, !Tokens).\nor_loop(PrevError, [Parser | Parsers], Result, !Tokens) :-\n StartTokens = !.Tokens,\n Parser(Result0, !Tokens),\n ( Result0 = ok(_),\n Result = Result0\n ; Result0 = error(_, _, _),\n !:Tokens = StartTokens,\n NextError = latest_error(PrevError, Result0),\n or_loop(NextError, Parsers, Result, !Tokens)\n ).\n\nwithin(Open, Parser, Close, Result, !Tokens) :-\n match_token(Open, OpenResult, !Tokens),\n ( OpenResult = ok(_),\n Parser(Result0, !Tokens),\n match_token(Close, CloseResult, !Tokens),\n ( if\n OpenResult = ok(_),\n Result0 = ok(X),\n CloseResult = ok(_)\n then\n Result = ok(X)\n else\n Result = combine_errors_2(Result0, CloseResult)\n )\n ; OpenResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\nwithin_use_last_error(Open, Parser, Close, Result, !Tokens) :-\n match_token(Open, OpenResult, !Tokens),\n ( OpenResult = ok(_),\n Parser(Result0, LastError, !Tokens),\n match_token(Close, CloseResult, !Tokens),\n ( if\n OpenResult = ok(_),\n Result0 = ok(X),\n CloseResult = ok(_)\n then\n Result = ok(X)\n else\n Result = combine_errors_2(\n latest_error(Result0, LastError) `with_type` parse_res(unit),\n CloseResult)\n )\n ; OpenResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n%-----------------------------------------------------------------------%\n\nparse_map(Map, Parser, Result, !Tokens) :-\n Parser(Result0, !Tokens),\n ( Result0 = ok(A),\n Result = ok(Map(A))\n ; Result0 = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n%-----------------------------------------------------------------------%\n\ncombine_errors_2(ok(_), ok(_)) = unexpected($pred, \"not an error\").\ncombine_errors_2(ok(_), error(C, G, E)) = error(C, G, E).\ncombine_errors_2(error(C, G, E), _) = error(C, G, E).\n\ncombine_errors_3(ok(_), ok(_), ok(_)) = unexpected($pred, \"not an error\").\ncombine_errors_3(ok(_), ok(_), error(C, G, E)) = error(C, G, E).\ncombine_errors_3(ok(_), error(C, G, E), _) = error(C, G, E).\ncombine_errors_3(error(C, G, E), _, _) = error(C, G, E).\n\ncombine_errors_4(ok(_), ok(_), ok(_), ok(_)) =\n unexpected($pred, \"not an error\").\ncombine_errors_4(ok(_), ok(_), ok(_), error(C, G, E)) = error(C, G, E).\ncombine_errors_4(ok(_), ok(_), error(C, G, E), _) = error(C, G, E).\ncombine_errors_4(ok(_), error(C, G, E), _, _) = error(C, G, E).\ncombine_errors_4(error(C, G, E), _, _, _) = error(C, G, E).\n\ncombine_errors_5(ok(_), ok(_), ok(_), ok(_), ok(_)) =\n unexpected($pred, \"not an error\").\ncombine_errors_5(ok(_), ok(_), ok(_), ok(_), error(C, G, E)) = error(C, G, E).\ncombine_errors_5(ok(_), ok(_), ok(_), error(C, G, E), _) = error(C, G, E).\ncombine_errors_5(ok(_), ok(_), error(C, G, E), _, _) = error(C, G, E).\ncombine_errors_5(ok(_), error(C, G, E), _, _, _) = error(C, G, E).\ncombine_errors_5(error(C, G, E), _, _, _, _) = error(C, G, E).\n\ncombine_errors_6(ok(_), ok(_), ok(_), ok(_), ok(_), ok(_)) =\n unexpected($pred, \"not an error\").\ncombine_errors_6(ok(_), ok(_), ok(_), ok(_), ok(_), error(C, G, E)) =\n error(C, G, E).\ncombine_errors_6(ok(_), ok(_), ok(_), ok(_), error(C, G, E), _) =\n error(C, G, E).\ncombine_errors_6(ok(_), ok(_), ok(_), error(C, G, E), _, _) = error(C, G, E).\ncombine_errors_6(ok(_), ok(_), error(C, G, E), _, _, _) = error(C, G, E).\ncombine_errors_6(ok(_), error(C, G, E), _, _, _, _) = error(C, G, E).\ncombine_errors_6(error(C, G, E), _, _, _, _, _) = error(C, G, E).\n\nlatest_error(ok(_), error(C, G, E)) = error(C, G, E).\nlatest_error(error(C, G, E), ok(_)) = error(C, G, E).\nlatest_error(error(C1, G1, E1), error(C2, G2, E2)) = Err :-\n compare(CR, C1, C2),\n (\n ( CR = (>)\n ; CR = (=)\n ),\n Err = error(C1, G1, E1)\n ;\n CR = (<),\n Err = error(C2, G2, E2)\n ).\n\nmap(M, ok(X)) = ok(M(X)).\nmap(_, error(C, G, E)) = error(C, G, E).\n\n%-----------------------------------------------------------------------%\n\nmatch_token(TA, error(nil_context, \"EOF\", string(TA)), [], []).\nmatch_token(TA, Result, Ts0@[token(TB, String, Context) | Ts1], Ts) :-\n ( if TA = TB then\n Result = ok(String),\n Ts = Ts1\n else\n Result = error(Context, string(TB), string(TA)),\n Ts = Ts0\n ).\n\nmatch_tokens([], ok(unit), !Tokens).\nmatch_tokens([T|Ts], Result, !Tokens) :-\n match_token(T, Result0, !Tokens),\n ( Result0 = ok(_),\n match_tokens(Ts, Result, !Tokens)\n ; Result0 = error(C, G, E),\n Result = error(C, G, E)\n ).\n\nnext_token(Expect, error(nil_context, \"EOF\", Expect), [], []).\nnext_token(_, ok(token_and_string(Token, String)),\n [token(Token, String, _) | Tokens], Tokens).\n\npeek_token([], no).\npeek_token([token(Token, _, _) | _], yes(Token)).\n\n%-----------------------------------------------------------------------%\n\nget_context([], nil_context).\nget_context([token(_, _, Context) | _], Context).\n\n%-----------------------------------------------------------------------%\n\nparse_nq_name(Result, !Tokens) :-\n match_token(ident_, Result0, !Tokens),\n Result = map(func(S) = nq_name_det(S), Result0).\n\nparse_q_name(Result, !Tokens) :-\n zero_or_more(parse_qualifier, ok(Qualifiers), !Tokens),\n match_token(ident_, IdentResult, !Tokens),\n Result = map((func(S) = q_name_from_strings_2(Qualifiers, S)),\n IdentResult).\n\n:- pred parse_qualifier(parse_res(string)::out,\n list(token(T))::in, list(token(T))::out) is det <= ident_parsing(T).\n\nparse_qualifier(Result, !Tokens) :-\n match_token(ident_, IdentResult, !Tokens),\n match_token(period_, DotMatch, !Tokens),\n ( if\n IdentResult = ok(Ident),\n DotMatch = ok(_)\n then\n Result = ok(Ident)\n else\n Result = combine_errors_2(IdentResult, DotMatch)\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/plzasm.m", "content": "%-----------------------------------------------------------------------%\n% Plasma assembler\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This program assembles and links the pz intermediate representation.\n%\n%-----------------------------------------------------------------------%\n:- module plzasm.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n\n:- pred main(io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module bool.\n:- import_module char.\n:- import_module getopt.\n:- import_module list.\n:- import_module maybe.\n:- import_module string.\n\n:- import_module asm.\n:- import_module asm_ast.\n:- import_module constant.\n:- import_module pz.\n:- import_module pz.write.\n:- import_module pzt_parse.\n:- import_module util.\n:- import_module util.my_exception.\n:- import_module util.mercury.\n:- import_module util.path.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\nmain(!IO) :-\n io.command_line_arguments(Args0, !IO),\n process_options(Args0, OptionsResult, !IO),\n ( OptionsResult = ok(PZAsmOpts),\n Mode = PZAsmOpts ^ pzo_mode,\n ( Mode = assemble(InputFile, OutputFile),\n promise_equivalent_solutions [!:IO] (\n run_and_catch(do_assemble(InputFile, OutputFile), plzasm,\n HadErrors, !IO),\n ( HadErrors = had_errors,\n io.set_exit_status(1, !IO)\n ; HadErrors = did_not_have_errors\n )\n )\n ; Mode = help,\n usage(!IO)\n ; Mode = version,\n version(\"Plasma Abstract Machine Assembler\", !IO)\n )\n ; OptionsResult = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n ).\n\n:- pred do_assemble(string::in, string::in, io::di, io::uo) is det.\n\ndo_assemble(InputFile, OutputFile, !IO) :-\n pzt_parse.parse(InputFile, MaybePZAst, !IO),\n ( MaybePZAst = ok(PZAst),\n assemble(PZAst, MaybePZ),\n ( MaybePZ = ok(PZ),\n write_pz(OutputFile, PZ, Result, !IO),\n ( Result = ok\n ; Result = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n )\n ; MaybePZ = errors(Errors),\n report_errors(\"\", Errors, !IO),\n set_exit_status(1, !IO)\n )\n ; MaybePZAst = errors(Errors),\n report_errors(\"\", Errors, !IO),\n set_exit_status(1, !IO)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type pzasm_options\n ---> pzasm_options(\n pzo_mode :: pzo_mode,\n pzo_verbose :: bool\n ).\n\n:- type pzo_mode\n ---> assemble(\n pzma_input_file :: string,\n pzma_output_file :: string\n )\n ; help\n ; version.\n\n:- pred process_options(list(string)::in, maybe_error(pzasm_options)::out,\n io::di, io::uo) is det.\n\nprocess_options(Args0, Result, !IO) :-\n OptionOpts = option_ops_multi(short_option, long_option, option_default),\n getopt.process_options(OptionOpts, Args0, Args, MaybeOptions),\n ( MaybeOptions = ok(OptionTable),\n lookup_bool_option(OptionTable, help, Help),\n lookup_bool_option(OptionTable, version, Version),\n lookup_bool_option(OptionTable, verbose, Verbose),\n ( if Help = yes then\n Result = ok(pzasm_options(help, Verbose))\n else if Version = yes then\n Result = ok(pzasm_options(version, Verbose))\n else\n ( if Args = [InputFile] then\n ( if\n lookup_string_option(OptionTable, output, Output0),\n Output0 \\= \"\"\n then\n Output = Output0\n else\n file_change_extension_det(constant.pz_text_extension,\n constant.output_extension, InputFile, Output)\n ),\n\n Result = ok(pzasm_options(assemble(InputFile, Output),\n Verbose))\n else\n Result = error(\"Error processing command line options: \" ++\n \"Expected exactly one input file\")\n )\n )\n ; MaybeOptions = error(ErrMsg),\n Result = error(\"Error processing command line options: \" ++ \n\t\toption_error_to_string(ErrMsg))\n ).\n\n:- pred usage(io::di, io::uo) is det.\n\nusage(!IO) :-\n io.write_string(\"Plasma assembler\\n\\n\", !IO),\n\n io.write_string(\n \" The plasma assembler creates plasma bytecode files from\\n\" ++\n \" a text representation.\\n\\n\", !IO),\n\n io.write_string(\"Usage:\\n\\n\", !IO),\n io.progname_base(\"plzasm\", ProgName, !IO),\n io.format(\" %s [-v] [-o | --output ] \\n\",\n [s(ProgName)], !IO),\n io.format(\" %s -h\\n\\n\", [s(ProgName)], !IO).\n\n:- type option\n ---> help\n ; verbose\n ; version\n ; output.\n\n:- pred short_option(char::in, option::out) is semidet.\n\nshort_option('h', help).\nshort_option('v', verbose).\nshort_option('o', output).\n\n:- pred long_option(string::in, option::out) is semidet.\n\nlong_option(\"help\", help).\nlong_option(\"verbose\", verbose).\nlong_option(\"version\", version).\nlong_option(\"output\", output).\n\n:- pred option_default(option::out, option_data::out) is multi.\n\noption_default(help, bool(no)).\noption_default(verbose, bool(no)).\noption_default(version, bool(no)).\noption_default(output, string(\"\")).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/plzbuild.m", "content": "%-----------------------------------------------------------------------%\n% Plasma builder\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This program starts the build process for Plasma projects\n%\n%-----------------------------------------------------------------------%\n:- module plzbuild.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n\n:- pred main(io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module bool.\n:- import_module char.\n:- import_module getopt.\n:- import_module list.\n:- import_module maybe.\n:- import_module string.\n\n:- import_module build.\n:- import_module constant.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.my_exception.\n:- import_module util.mercury.\n:- import_module util.path.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\nmain(!IO) :-\n io.command_line_arguments(Args0, !IO),\n process_options(Args0, OptionsResult, !IO),\n ( OptionsResult = ok(Mode),\n ( Mode = build(Options),\n build(Options, Errors, !IO),\n report_errors(\"\", Errors, !IO),\n ( if has_fatal_errors(Errors) then\n set_exit_status(1, !IO)\n else\n true\n )\n ; Mode = help,\n usage(!IO)\n ; Mode = version,\n version(\"Plasma Builder\", !IO)\n )\n ; OptionsResult = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type plzbuild_mode\n ---> build(plzbuild_options)\n ; help\n ; version.\n\n:- pred process_options(list(string)::in, maybe_error(plzbuild_mode)::out,\n io::di, io::uo) is det.\n\nprocess_options(Args0, Result, !IO) :-\n OptionOpts = option_ops_multi(short_option, long_option, option_default),\n getopt.process_options(OptionOpts, Args0, Args, MaybeOptions),\n ( MaybeOptions = ok(OptionTable),\n lookup_bool_option(OptionTable, help, Help),\n lookup_bool_option(OptionTable, version, Version),\n\n ( if Help = yes then\n Result = ok(help)\n else if Version = yes then\n Result = ok(version)\n else\n Verbose = handle_bool_option(OptionTable, verbose,\n verbose, terse),\n Rebuild = handle_bool_option(OptionTable, rebuild,\n need_rebuild, dont_rebuild),\n lookup_string_option(OptionTable, build_file, BuildFile),\n lookup_string_option(OptionTable, build_dir, BuildDir),\n lookup_bool_option(OptionTable, report_timing,\n ReportTimingBool),\n ( ReportTimingBool = yes,\n ReportTiming = report_timing\n ; ReportTimingBool = no,\n ReportTiming = dont_report_timing\n ),\n\n discover_tools_path(MaybeToolsPath, !IO),\n ( MaybeToolsPath = yes(ToolsPath)\n ; MaybeToolsPath = no,\n my_exception.sorry($file, $pred,\n \"We don't know how to determine plzbuild's path \" ++\n \"(OS incompatibility?)\")\n ),\n\n MaybeModuleNames = maybe_error_list(map(\n string_to_module_name, Args)),\n ( MaybeModuleNames = ok(ModuleNames),\n Result = ok(build(plzbuild_options(ModuleNames, Verbose,\n Rebuild, BuildFile, BuildDir, ReportTiming, ToolsPath, \n \"../\")))\n ; MaybeModuleNames = error(Errors),\n Result = error(string_join(\"\\n\", Errors))\n )\n )\n ; MaybeOptions = error(ErrMsg),\n Result = error(\"Error processing command line options: \" ++ \n\t\toption_error_to_string(ErrMsg))\n ).\n\n:- func string_to_module_name(string) = maybe_error(nq_name, string).\n\nstring_to_module_name(String) = Result :-\n MaybeName = nq_name_from_string(String),\n ( MaybeName = ok(Name),\n Result = ok(Name)\n ; MaybeName = error(Error),\n Result = error(format(\"Plasma program name '%s' is invalid: %s.\",\n [s(String), s(Error)]))\n ).\n\n:- pred discover_tools_path(maybe(string)::out, io::di, io::uo) is det.\n\ndiscover_tools_path(MaybePath, !IO) :-\n progname(\"\", ProgramName, !IO),\n ( if ProgramName \\= \"\" then\n ( if file_and_dir(ProgramName, Dir, _) then\n MaybePath = yes(Dir)\n else\n get_environment_var(\"PATH\", MaybePathVar, !IO),\n ( MaybePathVar = yes(PathVar),\n Paths = words_separator(unify(':'), PathVar),\n search_path(Paths, ProgramName, MaybePath, !IO)\n ; MaybePathVar = no,\n MaybePath = no\n )\n )\n else\n MaybePath = no\n ).\n\n:- pred search_path(list(string)::in, string::in, maybe(string)::out,\n io::di, io::uo) is det.\n\nsearch_path([], _, no, !IO).\nsearch_path([Path | Paths], File, Result, !IO) :-\n file_and_dir(FullPath, Path, File),\n check_file_accessibility(FullPath, [execute], Res, !IO),\n ( Res = ok,\n Result = yes(Path)\n ; Res = error(_),\n search_path(Paths, File, Result, !IO)\n ).\n\n:- pred usage(io::di, io::uo) is det.\n\nusage(!IO) :-\n io.write_string(\"Plasma builder\\n\\n\", !IO),\n io.write_string(\n \" The Plasma builder is used to build Plasma programs and\\n\" ++\n \" libraries. It runs the other tools (compiler and linker)\\n\" ++\n \" to build an link the modules based on a `BUILD.plz` file.\\n\\n\",\n !IO),\n\n io.write_string(\"Usage:\\n\\n\", !IO),\n\n io.progname_base(\"plzbuild\", ProgName, !IO),\n io.format(\" %s [options] \\n\",\n [s(ProgName)], !IO),\n io.format(\" %s -h | --help>\\n\", [s(ProgName)], !IO),\n io.format(\" %s --version>\\n\", [s(ProgName)], !IO),\n io.nl(!IO),\n io.write_string(\"Options may include:\\n\\n\", !IO),\n io.write_string(\" -v | --verbose\\n\", !IO),\n io.write_string(\" Write verbose output\\n\\n\", !IO),\n io.write_string(\" --rebuild\\n\", !IO),\n io.write_string(\" Regenerate/rebuild everything regardless of timestamps\\n\\n\", !IO),\n io.write_string(\"Developer options:\\n\\n\", !IO),\n io.write_string(\" --build-file FILE\\n\", !IO),\n io.write_string(\" Use this build file.\\n\\n\", !IO),\n io.write_string(\" --build-dir DIR\\n\", !IO),\n io.write_string(\" Perform the build in this directory.\\n\\n\", !IO),\n io.write_string(\" --report-timing\\n\", !IO),\n io.write_string(\" Report the elapsed and CPU time for each sub-command.\\n\\n\", !IO).\n\n:- type option\n ---> rebuild\n ; build_file\n ; build_dir\n ; report_timing\n ; help\n ; verbose\n ; version.\n\n:- pred short_option(char::in, option::out) is semidet.\n\nshort_option('h', help).\nshort_option('v', verbose).\n\n:- pred long_option(string::in, option::out) is semidet.\n\nlong_option(\"rebuild\", rebuild).\nlong_option(\"build-file\", build_file).\nlong_option(\"build-dir\", build_dir).\nlong_option(\"report-timing\", report_timing).\nlong_option(\"help\", help).\nlong_option(\"verbose\", verbose).\nlong_option(\"version\", version).\n\n:- pred option_default(option::out, option_data::out) is multi.\n\noption_default(rebuild, bool(no)).\noption_default(build_file, string(build_file)).\noption_default(build_dir, string(build_directory)).\noption_default(report_timing, bool(no)).\noption_default(help, bool(no)).\noption_default(verbose, bool(no)).\noption_default(version, bool(no)).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/plzc.m", "content": "%-----------------------------------------------------------------------%\n% Plasma compiler\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This program compiles plasma modules.\n%\n%-----------------------------------------------------------------------%\n:- module plzc.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n\n:- pred main(io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module bool.\n:- import_module char.\n:- import_module cord.\n:- import_module getopt.\n:- import_module list.\n:- import_module maybe.\n:- import_module require.\n:- import_module string.\n\n:- import_module ast.\n:- import_module common_types.\n:- import_module compile.\n:- import_module compile_error.\n:- import_module constant.\n:- import_module context.\n:- import_module core.\n:- import_module core.arity_chk.\n:- import_module core.branch_chk.\n:- import_module core.pretty.\n:- import_module core.res_chk.\n:- import_module core.simplify.\n:- import_module core.type_chk.\n:- import_module core_to_pz.\n:- import_module dump_stage.\n:- import_module foreign.\n:- import_module options.\n:- import_module parse.\n:- import_module pre.\n:- import_module pre.import.\n:- import_module pz.\n:- import_module pz.pz_ds.\n:- import_module pz.write.\n:- import_module pz.pretty.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.my_exception.\n:- import_module util.log.\n:- import_module util.mercury.\n:- import_module util.path.\n:- import_module util.result.\n:- import_module util.my_time.\n:- import_module write_interface.\n\n%-----------------------------------------------------------------------%\n\nmain(!IO) :-\n now(StartTime, !IO),\n io.command_line_arguments(Args0, !IO),\n process_options(Args0, OptionsResult, !IO),\n ( OptionsResult = ok(PlasmaCOpts),\n ( PlasmaCOpts = plasmac_options(GeneralOpts, Mode),\n verbose_output(GeneralOpts ^ go_verbose,\n format(\"Parsing %s\\n\", [s(GeneralOpts ^ go_input_file)]),\n !IO),\n parse(GeneralOpts ^ go_input_file, MaybePlasmaAst, !IO),\n ( MaybePlasmaAst = ok(PlasmaAst),\n promise_equivalent_solutions [!:IO, HadErrors] (\n ( Mode = compile(CompileOpts),\n run_and_catch(do_compile(GeneralOpts, CompileOpts,\n PlasmaAst),\n plzc, HadErrors, !IO)\n ; Mode = make_interface,\n run_and_catch(do_make_interface(GeneralOpts, PlasmaAst),\n plzc, HadErrors, !IO)\n ; Mode = make_typeres_exports,\n run_and_catch(\n do_make_typeres_exports(GeneralOpts, PlasmaAst),\n plzc, HadErrors, !IO)\n ; Mode = scan(TargetBytecode, TargetInterface),\n run_and_catch(\n do_make_dep_info(GeneralOpts, TargetBytecode,\n TargetInterface, PlasmaAst),\n plzc, HadErrors, !IO)\n ; Mode = make_foreign(OutputHeader),\n run_and_catch(do_make_foreign(GeneralOpts,\n OutputHeader, PlasmaAst),\n plzc, HadErrors, !IO)\n ),\n ReportTiming = GeneralOpts ^ go_report_timing,\n ( ReportTiming = report_command_times,\n now(EndTime, !IO),\n format(\"%s\\n\",\n [s(format_duration(diff_time(EndTime, StartTime)))],\n !IO)\n ; ReportTiming = no_timing\n )\n ),\n ( HadErrors = had_errors,\n io.set_exit_status(2, !IO)\n ; HadErrors = did_not_have_errors\n )\n ; MaybePlasmaAst = errors(Errors),\n report_errors(GeneralOpts ^ go_source_dir, Errors, !IO),\n set_exit_status(1, !IO)\n )\n ; PlasmaCOpts = plasmac_help,\n usage(!IO)\n ; PlasmaCOpts = plasmac_version,\n version(\"Plasma Compiler\", !IO)\n )\n ; OptionsResult = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred do_compile(general_options::in, compile_options::in, ast::in,\n io::di, io::uo) is det.\n\ndo_compile(GeneralOpts, CompileOpts, PlasmaAst, !IO) :-\n compile(GeneralOpts, CompileOpts, PlasmaAst, MaybePZ, !IO),\n ( MaybePZ = ok(PZ, Errors),\n report_errors(GeneralOpts ^ go_source_dir, Errors, !IO),\n ( if has_fatal_errors(Errors) then\n unexpected($file, $pred, \"Fatal errors returned with result\")\n else\n true\n ),\n\n ( if\n ( GeneralOpts ^ go_warn_as_error = no\n ; is_empty(Errors)\n )\n then\n WriteOutput = GeneralOpts ^ go_write_output,\n ( WriteOutput = write_output,\n OutputFile = GeneralOpts ^ go_output_file,\n write_pz(OutputFile, PZ, Result, !IO),\n ( Result = ok\n ; Result = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n )\n ; WriteOutput = dont_write_output\n )\n else\n set_exit_status(1, !IO)\n )\n ; MaybePZ = errors(Errors),\n report_errors(GeneralOpts ^ go_source_dir, Errors, !IO),\n set_exit_status(1, !IO)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred do_make_interface(general_options::in, ast::in, io::di, io::uo) is det.\n\ndo_make_interface(GeneralOpts, PlasmaAst, !IO) :-\n process_declarations(GeneralOpts, PlasmaAst, MaybeCore, !IO),\n ( MaybeCore = ok(Core, Errors),\n report_errors(GeneralOpts ^ go_source_dir, Errors, !IO),\n ( if has_fatal_errors(Errors) then\n unexpected($file, $pred, \"Fatal errors returned with result\")\n else\n true\n ),\n\n ( if\n ( GeneralOpts ^ go_warn_as_error = no\n ; is_empty(Errors)\n )\n then\n WriteOutput = GeneralOpts ^ go_write_output,\n ( WriteOutput = write_output,\n % The interface is within the core representation. We will\n % extract and pretty print the parts we need.\n OutputFile = GeneralOpts ^ go_output_file,\n write_interface(OutputFile, Core, Result, !IO),\n ( Result = ok\n ; Result = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n )\n ; WriteOutput = dont_write_output\n )\n else\n set_exit_status(1, !IO)\n )\n ; MaybeCore = errors(Errors),\n report_errors(GeneralOpts ^ go_source_dir, Errors, !IO),\n set_exit_status(1, !IO)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred do_make_dep_info(general_options::in,\n string::in, string::in, ast::in, io::di, io::uo) is det.\n\ndo_make_dep_info(GeneralOpts, TargetBytecode, TargetInterface, PlasmaAst,\n !IO) :-\n check_module_name(GeneralOpts, PlasmaAst ^ a_context,\n PlasmaAst ^ a_module_name, init, ModuleNameErrors),\n ( if has_fatal_errors(ModuleNameErrors) then\n report_errors(GeneralOpts ^ go_source_dir, ModuleNameErrors, !IO),\n set_exit_status(1, !IO)\n else\n filter_entries(PlasmaAst ^ a_entries, Imports0, _, _, _, _),\n % TODO: Include only dependencies required to build interface files,\n % that is those that are used by types and resources only.\n ast_to_import_list(PlasmaAst ^ a_module_name, \"..\",\n GeneralOpts ^ go_import_whitelist_file, Imports0, Imports, !IO),\n\n WriteOutput = GeneralOpts ^ go_write_output,\n ( WriteOutput = write_output,\n % The interface is within the core representation. We will\n % extract and pretty print the parts we need.\n OutputFile = GeneralOpts ^ go_output_file,\n write_dep_info(OutputFile, TargetBytecode, TargetInterface,\n Imports, Result, !IO),\n ( Result = ok\n ; Result = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n )\n ; WriteOutput = dont_write_output\n )\n ).\n\n:- pred write_dep_info(string::in, string::in, string::in,\n list(import_info)::in, maybe_error::out, io::di, io::uo) is det.\n\nwrite_dep_info(Filename, TargetBytecode, TargetInterface, Info, Result, !IO) :-\n open_output(Filename, OpenRes, !IO),\n ( OpenRes = ok(File),\n Result = ok,\n write_string(File, \"ninja_dyndep_version = 1\\n\\n\", !IO),\n BytecodeDeps = string_join(\" \",\n filter_map(ii_potential_interface_file(interface_import), Info)),\n InterfaceDeps = string_join(\" \",\n filter_map(ii_potential_interface_file(typeres_import), Info)),\n format(File, \"build %s : dyndep | %s\\n\\n\",\n [s(TargetBytecode), s(BytecodeDeps)], !IO),\n format(File, \"build %s : dyndep | %s\\n\\n\",\n [s(TargetInterface), s(InterfaceDeps)], !IO),\n close_output(File, !IO)\n ; OpenRes = error(Error),\n Result = error(format(\"%s: %s\", [s(Filename), s(error_message(Error))]))\n ).\n\n % Return the interface file for this module if it exists or we source\n % exists so it can be built.\n %\n:- func ii_potential_interface_file(import_type, import_info) = string\n is semidet.\n\nii_potential_interface_file(ImportType, ImportInfo) = File :-\n ( ImportType = interface_import,\n File = ImportInfo ^ ii_interface_file\n ; ImportType = typeres_import,\n File = ImportInfo ^ ii_typeres_file\n ),\n ( file_exists = ImportInfo ^ ii_interface_exists\n ; yes(_) = ImportInfo ^ ii_source_file\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred do_make_typeres_exports(general_options::in, ast::in, io::di, io::uo)\n is det.\n\ndo_make_typeres_exports(GeneralOpts, PlasmaAst, !IO) :-\n ExportsRes = find_typeres_exports(GeneralOpts, PlasmaAst),\n SourcePath = GeneralOpts ^ go_source_dir,\n ( ExportsRes = ok(Exports, Errors),\n WriteOutput = GeneralOpts ^ go_write_output,\n ( WriteOutput = write_output,\n OutputFile = GeneralOpts ^ go_output_file,\n write_typeres_exports(OutputFile, PlasmaAst ^ a_module_name,\n Exports, Result, !IO),\n ( Result = ok\n ; Result = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n )\n ; WriteOutput = dont_write_output\n ),\n report_errors(SourcePath, Errors, !IO)\n ; ExportsRes = errors(Errors),\n report_errors(SourcePath, Errors, !IO),\n exit_error(\"Failed\", !IO)\n ).\n\n:- pred write_typeres_exports(string::in, q_name::in, typeres_exports::in,\n maybe_error::out, io::di, io::uo) is det.\n\nwrite_typeres_exports(Filename, ModuleName, Exports, Result, !IO) :-\n io.open_output(Filename, OpenRes, !IO),\n ( OpenRes = ok(File),\n format(File, \"module %s\\n\\n\", [s(q_name_to_string(ModuleName))],\n !IO),\n write_string(File, append_list(\n map(func(R) = format(\"resource %s\\n\", [s(q_name_to_string(R))]),\n Exports ^ te_resources)),\n !IO),\n nl(File, !IO),\n write_string(File, append_list(\n map(func({N, A}) = format(\"type %s/%d\\n\",\n [s(q_name_to_string(N)), i(A ^ a_num)]),\n Exports ^ te_types)),\n !IO),\n close_output(File, !IO),\n Result = ok\n ; OpenRes = error(Error),\n Result = error(format(\"%s: %s\\n\",\n [s(Filename), s(error_message(Error))]))\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred do_make_foreign(general_options::in, string::in, ast::in,\n io::di, io::uo) is det.\n\ndo_make_foreign(GeneralOpts, OutputHeader, PlasmaAst, !IO) :-\n MaybeForeignInfo = make_foreign(PlasmaAst),\n ( MaybeForeignInfo = ok(ForeignInfo),\n write_foreign(GeneralOpts, OutputHeader, ForeignInfo, !IO)\n ; MaybeForeignInfo = errors(Errors),\n report_errors(GeneralOpts ^ go_source_dir, Errors, !IO),\n set_exit_status(1, !IO)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type plasmac_options\n ---> plasmac_options(\n pco_general :: general_options,\n pco_mode :: pco_mode_options\n )\n ; plasmac_help\n ; plasmac_version.\n\n:- type pco_mode_options\n ---> compile(\n pmo_compile_opts :: compile_options\n )\n ; make_interface\n ; make_typeres_exports\n ; scan(\n pmo_d_output :: string,\n pmo_d_interface :: string\n )\n ; make_foreign(\n pmo_f_output_header :: string\n ).\n\n:- pred process_options(list(string)::in, maybe_error(plasmac_options)::out,\n io::di, io::uo) is det.\n\nprocess_options(Args0, Result, !IO) :-\n OptionOpts = option_ops_multi(short_option, long_option, option_default),\n getopt.process_options(OptionOpts, Args0, Args, MaybeOptions),\n ( MaybeOptions = ok(OptionTable),\n lookup_bool_option(OptionTable, help, Help),\n lookup_bool_option(OptionTable, version, Version),\n ( if Help = yes then\n Result = ok(plasmac_help)\n else if Version = yes then\n Result = ok(plasmac_version)\n else\n ( if Args = [InputPath] then\n process_options_mode(OptionTable, OutputExtension,\n ModeResult),\n GeneralOpts = process_options_general(OptionTable, InputPath,\n OutputExtension),\n\n ( ModeResult = ok(ModeOpts),\n Result = ok(plasmac_options(GeneralOpts, ModeOpts))\n ; ModeResult = error(Error),\n Result = error(Error)\n )\n else\n Result = error(\"Error processing command line options: \" ++\n \"Expected exactly one input file\")\n )\n )\n ; MaybeOptions = error(ErrMsg),\n Result = error(\"Error processing command line options: \" ++\n\t\toption_error_to_string(ErrMsg))\n ).\n\n:- pred process_options_mode(option_table(option)::in, string::out,\n maybe_error(pco_mode_options)::out) is det.\n\nprocess_options_mode(OptionTable, OutputExtension, Result) :-\n lookup_string_option(OptionTable, mode_, Mode),\n ( if Mode = \"compile\" then\n DoSimplify = handle_bool_option(OptionTable, simplify,\n do_simplify_pass, skip_simplify_pass),\n EnableTailcalls = handle_bool_option(OptionTable, tailcalls,\n enable_tailcalls, dont_enable_tailcalls),\n Result = ok(compile(\n compile_options(DoSimplify, EnableTailcalls))),\n OutputExtension = constant.output_extension\n else if Mode = \"make-interface\" then\n Result = ok(make_interface),\n OutputExtension = constant.interface_extension\n else if Mode = \"make-typeres-exports\" then\n Result = ok(make_typeres_exports),\n OutputExtension = constant.typeres_extension\n else if Mode = \"scan\" then\n lookup_string_option(OptionTable, target_bytecode, TargetBytecode),\n lookup_string_option(OptionTable, target_interface, TargetInterface),\n Result = ok(scan(TargetBytecode, TargetInterface)),\n OutputExtension = constant.depends_extension\n else if Mode = \"generate-foreign\" then\n lookup_string_option(OptionTable, output_header, OutputHeader),\n Result = ok(make_foreign(OutputHeader)),\n OutputExtension = constant.cpp_extension\n else\n Result = error(\n format(\"Error processing command line options, \" ++\n \"unknown mode `%s`.\",\n [s(Mode)])),\n OutputExtension = \".error\" % This is never seen\n ).\n\n:- func process_options_general(option_table(option), string, string) =\n general_options.\n\nprocess_options_general(OptionTable, InputPath, OutputExtension) =\n GeneralOpts :-\n lookup_string_option(OptionTable, source_path,\n SourcePath),\n file_and_dir_det(\".\", InputPath, InputDir, InputFile),\n\n ( if\n lookup_string_option(OptionTable, output_file,\n OutputFile0),\n OutputFile0 \\= \"\"\n then\n OutputFile = OutputFile0\n else\n file_change_extension_det(constant.source_extension,\n OutputExtension, InputFile, OutputFile)\n ),\n\n lookup_string_option(OptionTable, import_whitelist,\n ImportWhitelist),\n ( if ImportWhitelist = \"\" then\n MbImportWhitelist = no\n else\n MbImportWhitelist = yes(ImportWhitelist)\n ),\n\n lookup_string_option(OptionTable, module_name_check,\n ModuleNameCheck),\n ( if ModuleNameCheck = \"\" then\n MbModuleNameCheck = no\n else\n MbModuleNameCheck = yes(ModuleNameCheck)\n ),\n\n Verbose = handle_bool_option(OptionTable, verbose, verbose, silent),\n lookup_bool_option(OptionTable, warn_as_error, WError),\n DumpStages = handle_bool_option(OptionTable, dump_stages,\n dump_stages, dont_dump_stages),\n WriteOutput = handle_bool_option(OptionTable, write_output,\n write_output, dont_write_output),\n ReportTiming = handle_bool_option(OptionTable, report_timing,\n report_command_times, no_timing),\n\n GeneralOpts = general_options(InputDir, SourcePath, InputPath,\n OutputFile, MbImportWhitelist, MbModuleNameCheck, WError, Verbose,\n DumpStages, WriteOutput, ReportTiming).\n\n:- pred usage(io::di, io::uo) is det.\n\nusage(!IO) :-\n io.write_string(\"Plasma compiler\\n\\n\", !IO),\n io.write_string(\n \" The plasma compiler compiles plasma source code modules and\\n\" ++\n \" generates bytecode. It also has other modes to generate\\n\" ++\n \" interface files or dependency information.\\n\\n\", !IO),\n\n io.write_string(\"Usage:\\n\\n\", !IO),\n io.progname_base(\"plzc\", ProgName, !IO),\n io.format(\" %s -h | --help\\n\", [s(ProgName)], !IO),\n io.format(\" %s --version\\n\\n\", [s(ProgName)], !IO),\n io.format(\" %s [-v] -o [compilation opts] \\n\",\n [s(ProgName)], !IO),\n io.write_string(\" Compilation mode.\\n\\n\", !IO),\n io.format(\" %s [-v] --mode make-interface -o \\n\",\n [s(ProgName)], !IO),\n io.write_string(\" Make interface mode.\\n\\n\", !IO),\n io.format(\" %s [-v] --mode make-typeres-exports -o \\n\",\n [s(ProgName)], !IO),\n io.write_string(\" Make the typeres interface file.\\n\\n\", !IO),\n io.format(\" %s [-v] --mode scan \\n\",\n [s(ProgName)], !IO),\n io.write_string(\" --target-bytecode $bytecode\\n\", !IO),\n io.write_string(\" --target-interface $interface\\n\", !IO),\n io.write_string(\" -o \\n\", !IO),\n io.write_string(\" Scan source for dependencies.\\n\\n\", !IO),\n io.format(\" %s [-v] --mode generate-foreign -o \\n\",\n [s(ProgName)], !IO),\n io.write_string(\" Generate runtime code required to register foeign functions.\\n\\n\", !IO),\n\n io.write_string(\"General options:\\n\\n\", !IO),\n io.write_string(\" -h | --help\\n\" ++\n \" Help text (you're looking at it)\\n\\n\", !IO),\n io.write_string(\" -v | --verbose\\n\" ++\n \" Verbose output\\n\\n\", !IO),\n io.write_string(\" --version\\n\" ++\n \" Version information\\n\\n\", !IO),\n io.write_string(\n \" -o | --output-file \\n\" ++\n \" Specify output file (compiler will guess otherwise)\\n\\n\", !IO),\n io.write_string(\" --mode MODE\\n\" ++\n \" Specify what the compiler should do:\\n\" ++\n \" scan - \" ++\n \"Scan code for dependency information,\\n\" ++\n \" make-interface - Generate the interface file,\\n\" ++\n \" make-typeres-exports - \" ++\n \"Generate the typeres interface file.\\n\" ++\n \" compile (default) - Compile the module,\\n\" ++\n \" generate-foreign - \" ++\n \"Generate foreign code registration.\\n\\n\", !IO),\n\n io.write_string(\"Scan options:\\n\\n\", !IO),\n io.write_string(\" --target-bytecode \\n\" ++\n \" is the name of the bytecode file in the ninja\\n\" ++\n \" build file\\n\\n\",\n !IO),\n io.write_string(\" --target-interface \\n\" ++\n \" is the name of the interface file in the ninja\\n\" ++\n \" build file\\n\\n\",\n !IO),\n\n io.write_string(\"Compilation options:\\n\\n\", !IO),\n io.write_string(\" --warnings-as-errors\\n\" ++\n \" All warnings are fatal\\n\\n\", !IO),\n io.write_string(\" --no-simplify\\n\" ++\n \" Disable the simplification optimisations\\n\\n\", !IO),\n\n io.write_string(\"Developer options:\\n\\n\", !IO),\n io.write_string(\" --dump-stages\\n\" ++\n \" Dump the program representation at each stage of\\n\" ++\n \" compilation, each stage is saved to a seperate file in\\n\" ++\n \" the output directory\\n\\n\", !IO),\n io.write_string(\" --no-write-output\\n\" ++\n \" Skip writing the output file (for testing)\\n\\n\", !IO),\n io.write_string(\" --no-tailcalls\\n\" ++\n \" Do not generate tailcalls\\n\\n\", !IO),\n\n io.write_string(\"Internal options:\\n\\n\", !IO),\n io.write_string(\" --import-whitelist \\n\" ++\n \" Imports are checked against the Mercury term in this file\\n\" ++\n \" generated by plzbuild.\\n\\n\", !IO),\n io.write_string(\" --module-name-check \\n\" ++\n \" Check that this is the module name in the source file.\\n\\n\",\n !IO),\n io.write_string(\" --source-path \\n\" ++\n \" Subtract this path from source filenames when printing\\n\" ++\n \" errors.\\n\\n\", !IO),\n io.write_string(\" --report-timing\\n\" ++\n \" Report the time taken to execute the compiler.\\n\\n\", !IO).\n\n:- type option\n ---> help\n ; verbose\n ; version\n ; mode_\n ; output_file\n ; output_header\n ; target_bytecode\n ; target_interface\n ; import_whitelist\n ; module_name_check\n ; source_path\n ; warn_as_error\n ; dump_stages\n ; write_output\n ; report_timing\n ; simplify\n ; tailcalls.\n\n:- pred short_option(char::in, option::out) is semidet.\n\nshort_option('h', help).\nshort_option('v', verbose).\nshort_option('o', output_file).\n\n:- pred long_option(string::in, option::out) is semidet.\n\nlong_option(\"help\", help).\nlong_option(\"verbose\", verbose).\nlong_option(\"version\", version).\nlong_option(\"mode\", mode_).\nlong_option(\"output-file\", output_file).\nlong_option(\"output-header\", output_header).\nlong_option(\"target-bytecode\", target_bytecode).\nlong_option(\"target-interface\", target_interface).\nlong_option(\"import-whitelist\", import_whitelist).\nlong_option(\"module-name-check\", module_name_check).\nlong_option(\"source-path\", source_path).\nlong_option(\"warnings-as-errors\", warn_as_error).\nlong_option(\"dump-stages\", dump_stages).\nlong_option(\"write-output\", write_output).\nlong_option(\"report-timing\", report_timing).\nlong_option(\"simplify\", simplify).\nlong_option(\"tailcalls\", tailcalls).\n\n:- pred option_default(option::out, option_data::out) is multi.\n\noption_default(help, bool(no)).\noption_default(verbose, bool(no)).\noption_default(version, bool(no)).\noption_default(mode_, string(\"compile\")).\noption_default(output_file, string(\"\")).\noption_default(output_header, string(\"\")).\noption_default(target_bytecode, string(\"\")).\noption_default(target_interface, string(\"\")).\noption_default(import_whitelist, string(\"\")).\noption_default(module_name_check, string(\"\")).\noption_default(source_path, string(\"\")).\noption_default(warn_as_error, bool(no)).\noption_default(dump_stages, bool(no)).\noption_default(write_output, bool(yes)).\noption_default(report_timing, bool(no)).\noption_default(simplify, bool(yes)).\noption_default(tailcalls, bool(yes)).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/plzdisasm.m", "content": "%-----------------------------------------------------------------------%\n% Plasma assembler\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This program disassembles pz intermediate representation.\n%\n%-----------------------------------------------------------------------%\n:- module plzdisasm.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n\n:- pred main(io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module bool.\n:- import_module char.\n:- import_module cord.\n:- import_module getopt.\n:- import_module list.\n:- import_module maybe.\n:- import_module string.\n\n:- import_module constant.\n:- import_module pz.\n:- import_module pz.pretty.\n:- import_module pz.read.\n:- import_module util.\n:- import_module util.my_exception.\n:- import_module util.mercury.\n\n%-----------------------------------------------------------------------%\n\nmain(!IO) :-\n io.command_line_arguments(Args0, !IO),\n process_options(Args0, OptionsResult, !IO),\n ( OptionsResult = ok(PZDisOpts),\n Mode = PZDisOpts ^ pzo_mode,\n ( Mode = disasm(InputFile),\n promise_equivalent_solutions [!:IO] (\n run_and_catch(do_dump(InputFile), plzasm,\n HadErrors, !IO),\n ( HadErrors = had_errors,\n io.set_exit_status(1, !IO)\n ; HadErrors = did_not_have_errors\n )\n )\n ; Mode = help,\n usage(!IO)\n ; Mode = version,\n version(\"Plasma Abstract Machine Disassembler\", !IO)\n )\n ; OptionsResult = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n ).\n\n:- pred do_dump(string::in, io::di, io::uo) is det.\n\ndo_dump(InputFile, !IO) :-\n read_pz(InputFile, Result, !IO),\n ( Result = ok(pz_read_result(Type, PZ)),\n Pretty =\n from_list([\"// Plasma file type: \", string(Type), \"\\n\\n\"]) ++\n pz_pretty(PZ),\n write_string(append_list(list(Pretty)), !IO)\n ; Result = error(Error),\n exit_error(Error, !IO)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type pzdis_options\n ---> pzdis_options(\n pzo_mode :: pzo_mode\n ).\n\n:- type pzo_mode\n ---> disasm(\n pzmd_input_file :: string\n )\n ; help\n ; version.\n\n:- pred process_options(list(string)::in, maybe_error(pzdis_options)::out,\n io::di, io::uo) is det.\n\nprocess_options(Args0, Result, !IO) :-\n OptionOpts = option_ops_multi(short_option, long_option, option_default),\n getopt.process_options(OptionOpts, Args0, Args, MaybeOptions),\n ( MaybeOptions = ok(OptionTable),\n lookup_bool_option(OptionTable, help, Help),\n lookup_bool_option(OptionTable, version, Version),\n ( if Help = yes then\n Result = ok(pzdis_options(help))\n else if Version = yes then\n Result = ok(pzdis_options(version))\n else\n ( if Args = [InputFile] then\n Result = ok(pzdis_options(disasm(InputFile)))\n else\n Result = error(\"Error processing command line options: \" ++\n \"Expected exactly one input file\")\n )\n )\n ; MaybeOptions = error(ErrMsg),\n Result = error(\"Error processing command line options: \" ++ \n\t\toption_error_to_string(ErrMsg))\n ).\n\n:- pred usage(io::di, io::uo) is det.\n\nusage(!IO) :-\n io.write_string(\"Plasma disassembler\\n\\n\", !IO),\n\n io.write_string(\n \" The Plasma disassembler outputs a text representation of\\n\" ++\n \" Plasma bytecode files.\\n\\n\", !IO),\n\n io.write_string(\"Usage:\\n\\n\", !IO),\n io.progname_base(\"plzdisasm\", ProgName, !IO),\n io.format(\" %s \\n\", [s(ProgName)], !IO),\n io.format(\" %s -h | --help\\n\", [s(ProgName)], !IO),\n io.format(\" %s --version\\n\\n\", [s(ProgName)], !IO).\n\n:- type option\n ---> help\n ; version.\n\n:- pred short_option(char::in, option::out) is semidet.\n\nshort_option('h', help).\n\n:- pred long_option(string::in, option::out) is semidet.\n\nlong_option(\"help\", help).\nlong_option(\"version\", version).\n\n:- pred option_default(option::out, option_data::out) is multi.\n\noption_default(help, bool(no)).\noption_default(version, bool(no)).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/plzgeninit.m", "content": "%-----------------------------------------------------------------------%\n% Plasma foreign initialisation generation\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This program assembles and links the pz intermediate representation.\n%\n%-----------------------------------------------------------------------%\n:- module plzgeninit.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n\n:- pred main(io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module bool.\n:- import_module char.\n:- import_module list.\n:- import_module getopt.\n:- import_module maybe.\n:- import_module string.\n\n:- import_module constant.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.mercury.\n:- import_module util.my_exception.\n:- import_module util.my_io.\n\n%-----------------------------------------------------------------------%\n\nmain(!IO) :-\n io.command_line_arguments(Args0, !IO),\n process_options(Args0, OptionsResult, !IO),\n ( OptionsResult = ok(PZGIOpts),\n Mode = PZGIOpts ^ pzo_mode,\n ( Mode = gen_init(OutputFile, Modules),\n promise_equivalent_solutions [!:IO] (\n run_and_catch(do_gen_init(OutputFile, Modules), plzgeninit,\n HadErrors, !IO),\n ( HadErrors = had_errors,\n io.set_exit_status(1, !IO)\n ; HadErrors = did_not_have_errors\n )\n )\n ; Mode = help,\n usage(!IO)\n ; Mode = version,\n version(\"Plasma Foreign Interface Generator\", !IO)\n )\n ; OptionsResult = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n ).\n\n:- pred do_gen_init(string::in, list(q_name)::in, io::di, io::uo) is det.\n\ndo_gen_init(OutputFile, Modules, !IO) :-\n write_temp_and_move(open_output, close_output,\n pred(F::in, R::out, IO0::di, IO::uo) is det :-\n write_gen_init(F, Modules, R, IO0, IO),\n OutputFile, Result, !IO),\n ( Result = ok\n ; Result = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n ).\n\n:- pred write_gen_init(output_stream::in, list(q_name)::in, maybe_error::out,\n io::di, io::uo) is det.\n\nwrite_gen_init(File, Modules, Result, !IO) :-\n write_string(File, \"// Foreign initialisation\\n\\n\", !IO),\n write_string(File, \"extern \\\"C\\\" {\\n\", !IO),\n write_string(File, \" bool pz_init_foreign_code(void *f, void *gc);\\n\", !IO),\n write_string(File, \"}\\n\\n\", !IO),\n\n % Forward declarations.\n foldl(write_declaration(File), Modules, !IO),\n\n write_string(File, \"bool pz_init_foreign_code(void *f, void *gc) {\\n\", !IO),\n foldl(write_call(File), Modules, !IO),\n write_string(File, \" return true;\\n\", !IO),\n write_string(File, \"}\\n\", !IO),\n\n Result = ok.\n\n:- pred write_declaration(output_stream::in, q_name::in,\n io::di, io::uo) is det.\n\nwrite_declaration(File, Module, !IO) :-\n format(File, \"bool pz_init_foreign_code_%s(void *f, void *gc);\\n\",\n [s(q_name_clobber(Module))], !IO).\n\n:- pred write_call(output_stream::in, q_name::in,\n io::di, io::uo) is det.\n\nwrite_call(File, Module, !IO) :-\n format(File, \" if (!pz_init_foreign_code_%s(f, gc)) return false;\\n\",\n [s(q_name_clobber(Module))], !IO).\n\n%%-----------------------------------------------------------------------%\n\n:- type pzgi_options\n ---> pzgeninit_options(\n pzo_mode :: pzgi_mode,\n pzo_verbose :: bool\n ).\n\n:- type pzgi_mode\n ---> gen_init(\n pzgi_output_file :: string,\n pzgi_modules :: list(q_name)\n )\n ; help\n ; version.\n\n:- pred process_options(list(string)::in, maybe_error(pzgi_options)::out,\n io::di, io::uo) is det.\n\nprocess_options(Args0, Result, !IO) :-\n OptionOpts = option_ops_multi(short_option, long_option, option_default),\n getopt.process_options(OptionOpts, Args0, Args, MaybeOptions),\n ( MaybeOptions = ok(OptionTable),\n lookup_bool_option(OptionTable, help, Help),\n lookup_bool_option(OptionTable, version, Version),\n lookup_bool_option(OptionTable, verbose, Verbose),\n ( if Help = yes then\n Result = ok(pzgeninit_options(help, Verbose))\n else if Version = yes then\n Result = ok(pzgeninit_options(version, Verbose))\n else\n ( if\n lookup_string_option(OptionTable, output, Output),\n Output \\= \"\"\n then\n MaybeInputs =\n maybe_error_list(map(q_name_from_dotted_string, Args)),\n ( MaybeInputs = ok(Inputs),\n Result = ok(pzgeninit_options(\n gen_init(Output, Inputs), Verbose))\n ; MaybeInputs = error(Errors),\n Result = error(\"Invalid module name: \" ++\n first_item(Errors))\n )\n else\n Result = error(\"No output file specified\")\n )\n )\n ; MaybeOptions = error(ErrMsg),\n Result = error(\"Error processing command line options: \" ++\n option_error_to_string(ErrMsg))\n ).\n\n:- pred usage(io::di, io::uo) is det.\n\nusage(!IO) :-\n io.write_string(\"Plasma foreign initialisation generator\\n\\n\", !IO),\n\n io.write_string(\n \" The Plasma foreign initialisation generator is used to\\n\" ++\n \" generate foreign code used to register foreign\\n\" ++\n \" implementations of Plasma functions.\\n\\n\", !IO),\n\n io.write_string(\"Usage:\\n\\n\", !IO),\n io.progname_base(\"plzgeninit\", ProgName, !IO),\n io.format(\" %s [-v] [-o | --output ]\\n\",\n [s(ProgName)], !IO),\n io.format(\" %s -h\\n\\n\", [s(ProgName)], !IO).\n\n:- type option\n ---> help\n ; verbose\n ; version\n ; output.\n\n:- pred short_option(char::in, option::out) is semidet.\n\nshort_option('h', help).\nshort_option('v', verbose).\nshort_option('o', output).\n\n:- pred long_option(string::in, option::out) is semidet.\n\nlong_option(\"help\", help).\nlong_option(\"verbose\", verbose).\nlong_option(\"version\", version).\nlong_option(\"output\", output).\n\n:- pred option_default(option::out, option_data::out) is multi.\n\noption_default(help, bool(no)).\noption_default(verbose, bool(no)).\noption_default(version, bool(no)).\noption_default(output, string(\"\")).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/plzlnk.m", "content": "%-----------------------------------------------------------------------%\n% Plasma linker\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This program links the pz intermediate representation.\n%\n%-----------------------------------------------------------------------%\n:- module plzlnk.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n\n:- pred main(io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module bool.\n:- import_module char.\n:- import_module getopt.\n:- import_module list.\n:- import_module maybe.\n:- import_module require.\n:- import_module string.\n\n:- import_module constant.\n:- import_module pz.\n:- import_module pz.pz_ds.\n:- import_module pz.read.\n:- import_module pz.write.\n:- import_module pz.link.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.my_exception.\n:- import_module util.mercury.\n:- import_module util.result.\n:- import_module util.my_time.\n\n%-----------------------------------------------------------------------%\n\nmain(!IO) :-\n now(StartTime, !IO),\n io.command_line_arguments(Args0, !IO),\n process_options(Args0, OptionsResult, !IO),\n ( OptionsResult = ok(PZLnkOpts),\n Mode = PZLnkOpts ^ pzo_mode,\n ( Mode = link(LinkKind, InputFile, OutputFile),\n promise_equivalent_solutions [!:IO] (\n run_and_catch(\n link(LinkKind, InputFile, OutputFile), plzlnk, HadErrors,\n !IO),\n ( HadErrors = had_errors,\n io.set_exit_status(2, !IO)\n ; HadErrors = did_not_have_errors\n ),\n ReportTiming = PZLnkOpts ^ pzo_report_timing,\n ( ReportTiming = report_timing,\n now(EndTime, !IO),\n format(\"%s\\n\",\n [s(format_duration(diff_time(EndTime, StartTime)))],\n !IO)\n ; ReportTiming = dont_report_timing\n )\n )\n ; Mode = help,\n usage(!IO)\n ; Mode = version,\n version(\"Plasma Abstract Machine Linker\", !IO)\n )\n ; OptionsResult = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n ).\n\n:- pred link(pzo_link_kind::in, list(string)::in, string::in,\n io::di, io::uo) is det.\n\nlink(LinkKind, InputFilenames, OutputFilename, !IO) :-\n read_inputs(InputFilenames, [], MaybeInputs, !IO),\n ( MaybeInputs = ok(Inputs),\n do_link(LinkKind, Inputs, PZResult),\n ( PZResult = ok(PZ),\n write_pz(OutputFilename, PZ, WriteResult, !IO),\n ( WriteResult = ok\n ; WriteResult = error(ErrMsg),\n exit_error(ErrMsg, !IO)\n )\n ; PZResult = errors(Errors),\n report_errors(\"\", Errors, !IO),\n set_exit_status(1, !IO)\n )\n ; MaybeInputs = error(Error),\n exit_error(Error, !IO)\n ).\n\n:- pred read_inputs(list(string)::in, list(pz)::in, maybe_error(list(pz))::out,\n io::di, io::uo) is det.\n\nread_inputs([], PZs0, ok(PZs), !IO) :-\n reverse(PZs0, PZs).\nread_inputs([InputFilename | InputFilenames], PZs0, Result, !IO) :-\n read_pz(InputFilename, MaybeInput, !IO),\n ( MaybeInput = ok(pz_read_result(Type, PZ)),\n ( Type = pzft_object,\n read_inputs(InputFilenames, [PZ | PZs0], Result, !IO)\n ; Type = pzft_program,\n Result = error(\"Expected Plasma Object, not Plasma program\")\n ; Type = pzft_library,\n Result = my_exception.sorry($file, $pred,\n \"Maybe allow static-linking with libraries in the future?\")\n )\n ; MaybeInput = error(Error),\n Result = error(Error)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type pzlnk_options\n ---> pzlnk_options(\n pzo_mode :: pzo_mode,\n pzo_verbose :: verbose,\n pzo_report_timing :: report_timing\n ).\n\n:- type pzo_mode\n ---> link(\n pzml_link_kind :: pzo_link_kind,\n pzml_input_files :: list(string),\n pzml_output_file :: string\n )\n ; help\n ; version.\n\n:- type verbose\n ---> verbose\n ; terse.\n\n:- type report_timing\n ---> report_timing\n ; dont_report_timing.\n\n:- pred process_options(list(string)::in, maybe_error(pzlnk_options)::out,\n io::di, io::uo) is det.\n\nprocess_options(Args0, Result, !IO) :-\n OptionOpts = option_ops_multi(short_option, long_option, option_default),\n getopt.process_options(OptionOpts, Args0, Args, MaybeOptions),\n ( MaybeOptions = ok(OptionTable),\n lookup_bool_option(OptionTable, help, Help),\n lookup_bool_option(OptionTable, version, Version),\n Verbose = handle_bool_option(OptionTable, verbose,\n verbose, terse),\n ReportTiming = handle_bool_option(OptionTable, report_timing,\n report_timing, dont_report_timing),\n\n ( if Help = yes then\n Result = ok(pzlnk_options(help, Verbose, ReportTiming))\n else if Version = yes then\n Result = ok(pzlnk_options(version, Verbose, ReportTiming))\n else\n lookup_string_option(OptionTable, output, OutputFile),\n MaybeNames = process_names_option(OptionTable),\n\n ( if\n Args \\= [],\n OutputFile \\= \"\",\n MaybeNames = ok(Names)\n then\n MaybeLinkKind = process_link_kind_option(OptionTable, Names),\n ( MaybeLinkKind = ok(LinkKind),\n Result = ok(pzlnk_options(link(LinkKind, Args, OutputFile),\n Verbose, ReportTiming))\n ; MaybeLinkKind = error(Error),\n Result = error(Error)\n )\n else if Args = [] then\n Result = error(\"Provide one or more input files\")\n else if OutputFile = \"\" then\n Result = error(\n \"Output file argument is missing or not understood\")\n else if MaybeNames = error(Error) then\n Result = error(Error)\n else\n unexpected($file, $pred, \"Unhandled error\")\n )\n )\n ; MaybeOptions = error(ErrMsg),\n Result = error(\"Error processing command line options: \" ++ \n\t\toption_error_to_string(ErrMsg))\n ).\n\n:- func process_names_option(option_table(option)) =\n maybe_error(list(nq_name)).\n\nprocess_names_option(OptionTable) = MaybeNames :-\n lookup_accumulating_option(OptionTable, name, Names0),\n MaybeNames0 = maybe_error_list( map(string_to_module_name, Names0)),\n ( MaybeNames0 = error(Errors),\n ( Errors = [],\n unexpected($file, $pred, \"This never happens\")\n ; Errors = [Error]\n ; Errors = [_, _ | _],\n Error = \"Multiple errors:\\n\" ++\n append_list(list_join([\"\\n\"], Errors))\n ),\n MaybeNames = error(Error)\n ; MaybeNames0 = ok(Names),\n MaybeNames = ok(Names)\n ).\n\n:- func process_link_kind_option(option_table(option), list(nq_name)) =\n maybe_error(pzo_link_kind).\n\nprocess_link_kind_option(OptionTable, Names) = MaybeLinkKind :-\n lookup_bool_option(OptionTable, library, Library),\n lookup_string_option(OptionTable, entrypoint, EntryPointStr),\n ( Library = no,\n ( if Names = [Name] then\n ( if EntryPointStr \\= \"\" then\n MaybeEntryPoint0 = q_name_from_dotted_string(EntryPointStr),\n ( MaybeEntryPoint0 = ok(EntryPoint),\n MaybeLinkKind = ok(pz_program(yes(EntryPoint), Name))\n ; MaybeEntryPoint0 = error(Error),\n MaybeLinkKind = error(\n format(\"Invalid entry point name '%s': %s\",\n [s(EntryPointStr), s(Error)]))\n )\n else\n MaybeLinkKind = ok(pz_program(no, Name))\n )\n else\n MaybeLinkKind = error(\"Wrong number of names provided\")\n )\n ; Library = yes,\n ( if EntryPointStr \\= \"\" then\n MaybeLinkKind = error(\"Libraries can't have entrypoints\")\n else\n MaybeLinkKind = ok(pz_library(Names))\n )\n ).\n\n:- func string_to_module_name(string) = maybe_error(nq_name, string).\n\nstring_to_module_name(String) = Result :-\n MaybeName = nq_name_from_string(String),\n ( MaybeName = ok(Name),\n Result = ok(Name)\n ; MaybeName = error(Error),\n Result = error(format(\n \"Plasma program name (%s) is missing or invalid: %s\",\n [s(String), s(Error)]))\n ).\n\n:- pred usage(io::di, io::uo) is det.\n\nusage(!IO) :-\n io.write_string(\"Plasma linker\\n\\n\", !IO),\n io.write_string(\n \" The linker is used by plzbuild to link Plasma objects\\n\" ++\n \" into programs and libraries\\n\\n\", !IO),\n\n io.write_string(\"Usage:\\n\\n\", !IO),\n io.progname_base(\"plzlnk\", ProgName, !IO),\n io.format(\" %s [-e ] \\n\",\n [s(ProgName)], !IO),\n io.format(\" %s --library \\n\",\n [s(ProgName)], !IO),\n io.format(\" %s -h | --help>\\n\", [s(ProgName)], !IO),\n io.format(\" %s --version>\\n\", [s(ProgName)], !IO),\n io.write_string(\"\\nOptions:\\n\\n\", !IO),\n io.write_string(\" -v | --verbose Verbose\\n\", !IO),\n io.write_string(\" --report-timing Report linker timing\\n\",\n !IO),\n io.write_string(\" -o | --output Output file\\n\", !IO),\n io.write_string(\" -e | --entrypoint Name of program entrypoint\\n\", !IO),\n io.write_string(\" --library Make a library\\n\", !IO),\n io.write_string(\" -n | --name Program name or multiple module names to\\n\", !IO),\n io.write_string(\" export (for libraries)\\n\", !IO),\n io.nl(!IO).\n\n:- type option\n ---> help\n ; verbose\n ; version\n ; output\n ; name\n ; entrypoint\n ; library\n ; report_timing.\n\n:- pred short_option(char::in, option::out) is semidet.\n\nshort_option('h', help).\nshort_option('v', verbose).\nshort_option('o', output).\nshort_option('n', name).\nshort_option('e', entrypoint).\n\n:- pred long_option(string::in, option::out) is semidet.\n\nlong_option(\"help\", help).\nlong_option(\"verbose\", verbose).\nlong_option(\"version\", version).\nlong_option(\"output\", output).\nlong_option(\"name\", name).\nlong_option(\"entrypoint\", entrypoint).\nlong_option(\"library\", library).\nlong_option(\"report-timing\", report_timing).\n\n:- pred option_default(option::out, option_data::out) is multi.\n\noption_default(help, bool(no)).\noption_default(verbose, bool(no)).\noption_default(version, bool(no)).\noption_default(output, string(\"\")).\noption_default(name, accumulating([])).\noption_default(entrypoint, string(\"\")).\noption_default(library, bool(no)).\noption_default(report_timing, bool(no)).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.ast_to_core.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pre.ast_to_core.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Plasma parse tree to core representation conversion\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module list.\n\n:- import_module ast.\n:- import_module common_types.\n:- import_module compile_error.\n:- import_module core.\n:- import_module core.function.\n:- import_module core.types.\n:- import_module options.\n:- import_module pre.env.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n % The informationa bout a resource we need for ast_to_core (a2c).\n %\n:- type a2c_resource\n ---> a2c_resource(\n r_name :: nq_name,\n r_id :: resource_id,\n r_resource :: ast_resource\n ).\n\n:- type a2c_type\n ---> a2c_type(\n t_name :: nq_name,\n t_id :: type_id,\n t_type :: ast_type(nq_name)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred ast_to_core_declarations(general_options::in,\n list(a2c_resource)::in, list(a2c_type)::in,\n list(nq_named(ast_function))::in, env::in, env::out, core::in, core::out,\n errors(compile_error)::in, errors(compile_error)::out,\n io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n% Exported for pre.import's use.\n%\n\n:- pred ast_to_func_decl(core::in, env::in, q_name::in, ast_function_decl::in,\n sharing::in, result(function, compile_error)::out) is det.\n\n % ast_to_core_type_i(GetCtorName, Env, TypeName, TypeId, Type, Result,\n % !Core)\n %\n % The constructors in an AST Type have a polymorphic name type. It\n % could be a q_name when reading from interfaces, or nq_name when\n % reading a local module. The caller provides GetCtorName which will\n % turn it into the actual q_name used within the core representation\n % (not the environment).\n %\n:- pred ast_to_core_type_i((func(Name) = q_name)::in, imported::in,\n env::in, q_name::in, type_id::in, ast_type(Name)::in,\n result({user_type, list(ctor_binding(Name))}, compile_error)::out,\n core::in, core::out) is det.\n\n % Map a constructor name to an ID, so that a caller can update the\n % environment.\n %\n:- type ctor_binding(Name)\n ---> cb(\n cb_name :: Name,\n cb_id :: ctor_id\n ).\n\n % After processing declarations, call this to process the bodies of\n % functions.\n %\n:- pred ast_to_core_funcs(general_options::in, q_name::in,\n list(nq_named(ast_function))::in, env::in, core::in, core::out,\n errors(compile_error)::in, errors(compile_error)::out, io::di, io::uo)\n is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module char.\n:- import_module cord.\n:- import_module map.\n:- import_module maybe.\n:- import_module pair.\n:- import_module require.\n:- import_module set.\n:- import_module string.\n\n:- import_module builtins.\n:- import_module constant.\n:- import_module context.\n:- import_module core.resource.\n:- import_module dump_stage.\n:- import_module pre.bang.\n:- import_module pre.branches.\n:- import_module pre.closures.\n:- import_module pre.from_ast.\n:- import_module pre.import.\n:- import_module pre.pre_ds.\n:- import_module pre.pretty.\n:- import_module pre.to_core.\n:- import_module util.my_exception.\n:- import_module util.log.\n:- import_module util.path.\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\nast_to_core_declarations(GOptions, Resources, Types, Funcs, !Env,\n !Core, !Errors, !IO) :-\n Verbose = GOptions ^ go_verbose,\n\n verbose_output(Verbose, \"pre_to_core: Processing resources\\n\", !IO),\n ast_to_core_resources(Resources, !Env, !Core, !Errors),\n\n verbose_output(Verbose, \"pre_to_core: Processing types\\n\", !IO),\n ast_to_core_types(Types, !Env, !Core, !Errors),\n\n verbose_output(Verbose, \"pre_to_core: Processing function signatures\\n\",\n !IO),\n foldl3(gather_funcs, Funcs, !Core, !Env, !Errors),\n\n verbose_output(Verbose, \"pre_to_core: Checking exports\\n\", !IO),\n add_errors(check_resource_exports(!.Core), !Errors),\n add_errors(check_type_exports(!.Core), !Errors),\n add_errors(check_function_exports(!.Core), !Errors).\n\n%-----------------------------------------------------------------------%\n\n:- pred ast_to_core_types(list(a2c_type)::in,\n env::in, env::out, core::in, core::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\nast_to_core_types(Types, !Env, !Core, !Errors) :-\n foldl3(ast_to_core_type, Types, !Env, !Core, !Errors).\n\n:- pred ast_to_core_type(a2c_type::in, env::in, env::out, core::in, core::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\nast_to_core_type(a2c_type(Name, TypeId, ASTType), !Env, !Core, !Errors) :-\n ModuleName = module_name(!.Core),\n ast_to_core_type_i(q_name_append(ModuleName), i_local, !.Env,\n q_name_append(ModuleName, Name),\n TypeId, ASTType, Result, !Core),\n ( Result = ok({Type, Ctors}),\n core_set_type(TypeId, Type, !Core),\n foldl((pred(C::in, E0::in, E::out) is det :-\n % TODO: Constructors in the environment may need to handle\n % their arity.\n env_add_constructor(q_name(C ^ cb_name), C ^ cb_id, E0, E)\n ), Ctors, !Env)\n ; Result = errors(Errors),\n add_errors(Errors, !Errors)\n ).\n\nast_to_core_type_i(GetName, Imported, Env, Name, TypeId,\n ast_type(Params, Constrs0, Sharing, Context), Result, !Core) :-\n % Check that each parameter is unique.\n foldl(check_param, Params, init, ParamsSet),\n\n map_foldl2(\n ast_to_core_type_constructor(GetName, Env, TypeId, Params, ParamsSet),\n Constrs0, CtorResults, init, _, !Core),\n CtorsResult = result_list_to_result(CtorResults),\n ( CtorsResult = ok(Ctors),\n CtorIds = map(func(C) = C ^ cb_id, Ctors),\n Result = ok({\n type_init(Name, Params, CtorIds, Sharing, Imported, Context),\n Ctors})\n ; CtorsResult = errors(Errors),\n Result = errors(Errors)\n ).\nast_to_core_type_i(_, _, _, Name, _, ast_type_abstract(Arity, Context),\n Result, !Core) :-\n Result = ok({type_init_abstract(Name, Arity, Context), []}).\n\n:- pred check_param(string::in, set(string)::in, set(string)::out) is det.\n\ncheck_param(Param, !Params) :-\n ( if insert_new(Param, !Params) then\n true\n else\n compile_error($file, $pred, \"Non unique type parameters\")\n ).\n\n:- pred ast_to_core_type_constructor((func(Name) = q_name)::in, env::in,\n type_id::in, list(string)::in, set(string)::in, at_constructor(Name)::in,\n result(ctor_binding(Name), compile_error)::out,\n set(q_name)::in, set(q_name)::out, core::in, core::out) is det.\n\nast_to_core_type_constructor(GetName, Env, Type, Params, ParamsSet,\n at_constructor(EnvSymbol, Fields0, Context), Result, !CtorNameSet,\n !Core) :-\n\n Symbol = GetName(EnvSymbol),\n ( if insert_new(Symbol, !CtorNameSet) then\n core_allocate_ctor_id(CtorId, !Core),\n\n map(ast_to_core_field(!.Core, Env, ParamsSet), Fields0, FieldResults),\n FieldsResult = result_list_to_result(FieldResults),\n ( FieldsResult = ok(Fields),\n Constructor = constructor(Symbol, Params, Fields),\n core_set_constructor(CtorId, Symbol, Type, Constructor, !Core),\n Result = ok(cb(EnvSymbol, CtorId))\n ; FieldsResult = errors(Errors),\n Result = errors(Errors)\n )\n else\n Result = return_error(Context, ce_type_duplicate_constructor(Symbol))\n ).\n\n:- pred ast_to_core_field(core::in, env::in, set(string)::in,\n at_field::in, result(type_field, compile_error)::out) is det.\n\nast_to_core_field(Core, Env, ParamsSet, at_field(Name, Type0, _),\n Result) :-\n Symbol = q_name_single(Name),\n TypeResult = build_type_ref(Core, Env, s_private,\n check_type_vars(ParamsSet), Type0),\n ( TypeResult = ok(Type),\n Result = ok(type_field(Symbol, Type))\n ; TypeResult = errors(Errors),\n Result = errors(Errors)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred ast_to_core_resources(list(a2c_resource)::in,\n env::in, env::out, core::in, core::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\nast_to_core_resources(Resources, !Env, !Core, !Errors) :-\n foldl2(ast_to_core_resource(!.Env), Resources, !Core, !Errors).\n\n:- pred ast_to_core_resource(env::in, a2c_resource::in, core::in, core::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\nast_to_core_resource(Env,\n a2c_resource(Name, Res, ast_resource(FromName, Sharing, Context)),\n !Core, !Errors) :-\n ( if\n env_search_resource(Env, FromName, FromRes)\n then\n FullName = q_name_append(module_name(!.Core), Name),\n core_set_resource(Res,\n r_other(FullName, FromRes, Sharing, i_local, Context), !Core)\n else\n add_error(Context, ce_resource_unknown(FromName), !Errors)\n ).\n\n%-----------------------------------------------------------------------%\n\nast_to_core_funcs(GOptions, ModuleName, Funcs, Env, !Core, !Errors, !IO) :-\n some [!Pre] (\n % 1. the func_to_pre step resolves symbols, builds a varmap,\n % builds var-use and var-def sets.\n list.foldl(func_to_pre(Env), Funcs, map.init, !:Pre),\n maybe_dump_stage(GOptions, ModuleName, \"pre1_initial\",\n pre_pretty(!.Core), !.Pre, !IO),\n\n % 2. Annotate closures with captured variable information\n map.map_values_only(compute_closures, !Pre),\n maybe_dump_stage(GOptions, ModuleName, \"pre2_closures\",\n pre_pretty(!.Core), !.Pre, !IO),\n\n % 3. Fixup how variables are used in branching code, this pass:\n % * checks that used variables are always well defined (eg\n % along all execution paths)\n % * Updates the reachability information for branches.\n % Reachability information is incomplete until after\n % typechecking.\n % * Adds terminating \"return\" statements where needed.\n %\n process_procs(fix_branches, !Pre, !Errors),\n maybe_dump_stage(GOptions, ModuleName, \"pre3_branches\",\n pre_pretty(!.Core), !.Pre, !IO),\n\n % 4. Check bang placment is okay\n ResErrors = cord_list_to_cord(\n map(check_bangs(!.Core), map.values(!.Pre))),\n add_errors(ResErrors, !Errors),\n maybe_dump_stage(GOptions, ModuleName, \"pre4_resources\",\n pre_pretty(!.Core), !.Pre, !IO),\n\n % 5. Transform the pre structure into an expression tree.\n % TODO: Handle return statements in branches, where some\n % branches fall-through and others don't.\n ( if not has_fatal_errors(!.Errors) then\n map.foldl(pre_to_core, !.Pre, !Core)\n else\n true\n )\n ).\n\n:- pred process_procs(func(V) = result(V, E), map(K, V), map(K, V),\n errors(E), errors(E)).\n:- mode process_procs(func(in) = (out) is det, in, out, in, out) is det.\n\nprocess_procs(Func, !Map, !Errors) :-\n map.map_values_foldl(process_proc(Func), !Map, !Errors).\n\n:- pred process_proc(func(V) = result(V, E), V, V, errors(E), errors(E)).\n:- mode process_proc(func(in) = (out) is det, in, out, in, out) is det.\n\nprocess_proc(Func, !Proc, !Errors) :-\n Result = Func(!.Proc),\n ( Result = ok(!:Proc)\n ; Result = errors(NewErrors),\n add_errors(NewErrors, !Errors)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred gather_funcs(nq_named(ast_function)::in, core::in, core::out,\n env::in, env::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\ngather_funcs(nq_named(Name, Func), !Core, !Env, !Errors) :-\n Func = ast_function(Decl, Body, Sharing, IsEntrypoint),\n Context = Decl ^ afd_context,\n NameStr = nq_name_to_string(Name),\n\n ( if\n core_allocate_function(FuncId, !Core),\n % Add the function to the environment with it's local name,\n % since we're in the scope of the module already.\n env_add_func(q_name(Name), FuncId, !Env)\n then\n QName = q_name_append(module_name(!.Core), Name),\n ast_to_func_decl(!.Core, !.Env, QName, Decl, Sharing, MaybeFunction),\n ( MaybeFunction = ok(Function0),\n ( Body = ast_body_block(_),\n Function = Function0\n ; Body = ast_body_foreign(_),\n func_set_foreign(Function0, Function)\n ),\n\n core_set_function(FuncId, Function, !Core),\n ( IsEntrypoint = is_entrypoint,\n func_get_type_signature(Function, Params, Returns, _),\n ListTypeId = env_operators(!.Env) ^ o_list_type,\n ( if\n Returns = [builtin_type(int)],\n ( Params = [],\n Entrypoint = entry_plain(FuncId)\n ; Params = [type_ref(ListTypeId, [builtin_type(string)])],\n Entrypoint = entry_argv(FuncId)\n )\n then\n core_add_entry_function(Entrypoint, !Core)\n else\n add_error(Context, ce_entry_function_wrong_signature,\n !Errors)\n )\n ; IsEntrypoint = not_entrypoint\n )\n ; MaybeFunction = errors(Errors),\n add_errors(Errors, !Errors)\n )\n else\n add_error(Context, ce_function_already_defined(NameStr), !Errors)\n ),\n\n ( Body = ast_body_block(Block),\n foldl3(gather_funcs_block, Block, !Core, !Env, !Errors)\n ; Body = ast_body_foreign(_)\n ).\n\n:- pred gather_nested_funcs(nq_name::in, ast_nested_function::in,\n core::in, core::out, env::in, env::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\ngather_nested_funcs(Name0, ast_nested_function(Decl, Body),\n !Core, !Env, !Errors) :-\n Context = Decl ^ afd_context,\n NameStr = mangle_lambda(nq_name_to_string(Name0), Context),\n Name = nq_name_det(NameStr),\n\n core_allocate_function(FuncId, !Core),\n env_add_lambda(NameStr, FuncId, !Env),\n\n QName = q_name_append(module_name(!.Core), Name),\n ast_to_func_decl(!.Core, !.Env, QName, Decl, s_private, MaybeFunction),\n ( MaybeFunction = ok(Function),\n core_set_function(FuncId, Function, !Core)\n ; MaybeFunction = errors(Errors),\n add_errors(Errors, !Errors)\n ),\n\n foldl3(gather_funcs_block, Body, !Core, !Env, !Errors).\n\nast_to_func_decl(Core, Env, Name, Decl, Sharing, Result) :-\n Decl = ast_function_decl(Params, Returns, Uses0, Context),\n % Build basic information about the function.\n ParamTypesResult = result_list_to_result(\n map(build_param_type(Core, Env, Sharing), Params)),\n ReturnTypeResults = map(\n build_type_ref(Core, Env, Sharing, dont_check_type_vars),\n Returns),\n ReturnTypesResult = result_list_to_result(ReturnTypeResults),\n map_foldl2(build_uses(Context, Env), Uses0, ResourceErrorss,\n set.init, Uses, set.init, Observes),\n ResourceErrors = cord_list_to_cord(ResourceErrorss),\n IntersectUsesObserves = intersect(Uses, Observes),\n ( if\n ParamTypesResult = ok(ParamTypes),\n ReturnTypesResult = ok(ReturnTypes),\n is_empty(ResourceErrors),\n is_empty(IntersectUsesObserves)\n then\n Function = func_init_user(Name, Context, Sharing, ParamTypes,\n ReturnTypes, Uses, Observes),\n Result = ok(Function)\n else\n some [!Errors] (\n !:Errors = init,\n add_errors_from_result(ParamTypesResult, !Errors),\n add_errors_from_result(ReturnTypesResult, !Errors),\n add_errors(ResourceErrors, !Errors),\n ( if not is_empty(IntersectUsesObserves) then\n Resources = list.map(core_get_resource(Core),\n set.to_sorted_list(IntersectUsesObserves)),\n add_error(Context, ce_uses_observes_not_distinct(Resources),\n !Errors)\n else\n true\n ),\n Result = errors(!.Errors)\n )\n ).\n\n:- pred gather_funcs_block(ast_block_thing::in,\n core::in, core::out, env::in, env::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\ngather_funcs_block(astbt_statement(Stmt), !Core, !Env, !Errors) :-\n ast_statement(Type, _) = Stmt,\n gather_funcs_stmt(Type, !Core, !Env, !Errors).\ngather_funcs_block(astbt_function(Name, Defn), !Core, !Env, !Errors) :-\n gather_nested_funcs(Name, Defn, !Core, !Env, !Errors).\n\n:- pred gather_funcs_stmt(ast_stmt_type(context)::in,\n core::in, core::out, env::in, env::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\ngather_funcs_stmt(s_call(Call), !Core, !Env, !Errors) :-\n gather_funcs_call(Call, !Core, !Env, !Errors).\ngather_funcs_stmt(s_assign_statement(_, Exprs), !Core, !Env, !Errors) :-\n foldl3(gather_funcs_expr, Exprs, !Core, !Env, !Errors).\ngather_funcs_stmt(s_var_statement(_), !Core, !Env, !Errors).\ngather_funcs_stmt(s_array_set_statement(_, ExprA, ExprB), !Core, !Env,\n !Errors) :-\n gather_funcs_expr(ExprA, !Core, !Env, !Errors),\n gather_funcs_expr(ExprB, !Core, !Env, !Errors).\ngather_funcs_stmt(s_return_statement(Exprs), !Core, !Env, !Errors) :-\n foldl3(gather_funcs_expr, Exprs, !Core, !Env, !Errors).\ngather_funcs_stmt(s_match_statement(Expr, Cases), !Core, !Env, !Errors) :-\n gather_funcs_expr(Expr, !Core, !Env, !Errors),\n foldl3(gather_funcs_case, Cases, !Core, !Env, !Errors).\ngather_funcs_stmt(s_ite(Cond, Then, Else), !Core, !Env, !Errors) :-\n gather_funcs_expr(Cond, !Core, !Env, !Errors),\n foldl3(gather_funcs_block, Then, !Core, !Env, !Errors),\n foldl3(gather_funcs_block, Else, !Core, !Env, !Errors).\n\n:- pred gather_funcs_case(ast_match_case::in,\n core::in, core::out, env::in, env::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\ngather_funcs_case(ast_match_case(_, Block), !Core, !Env, !Errors) :-\n foldl3(gather_funcs_block, Block, !Core, !Env, !Errors).\n\n:- pred gather_funcs_call(ast_call_like::in,\n core::in, core::out, env::in, env::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\ngather_funcs_call(Call, !Core, !Env, !Errors) :-\n ( Call = ast_call_like(Callee, Args)\n ; Call = ast_bang_call(Callee, Args)\n ),\n gather_funcs_expr(Callee, !Core, !Env, !Errors),\n foldl3(gather_funcs_expr, Args, !Core, !Env, !Errors).\n\n:- pred gather_funcs_expr(ast_expression::in,\n core::in, core::out, env::in, env::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\ngather_funcs_expr(e_call_like(Call), !Core, !Env, !Errors) :-\n gather_funcs_call(Call, !Core, !Env, !Errors).\ngather_funcs_expr(e_u_op(_, Expr), !Core, !Env, !Errors) :-\n gather_funcs_expr(Expr, !Core, !Env, !Errors).\ngather_funcs_expr(e_b_op(Left, _, Right), !Core, !Env, !Errors) :-\n gather_funcs_expr(Left, !Core, !Env, !Errors),\n gather_funcs_expr(Right, !Core, !Env, !Errors).\ngather_funcs_expr(e_if(Cond, Then, Else), !Core, !Env, !Errors) :-\n gather_funcs_expr(Cond, !Core, !Env, !Errors),\n foldl3(gather_funcs_expr, Then, !Core, !Env, !Errors),\n foldl3(gather_funcs_expr, Else, !Core, !Env, !Errors).\ngather_funcs_expr(e_match(Expr, Cases), !Core, !Env, !Errors) :-\n gather_funcs_expr(Expr, !Core, !Env, !Errors),\n foldl3(gather_funcs_expr_case, Cases, !Core, !Env, !Errors).\ngather_funcs_expr(e_symbol(_), !Core, !Env, !Errors).\ngather_funcs_expr(e_const(_), !Core, !Env, !Errors).\ngather_funcs_expr(e_array(Exprs), !Core, !Env, !Errors) :-\n foldl3(gather_funcs_expr, Exprs, !Core, !Env, !Errors).\n\n:- pred gather_funcs_expr_case(ast_expr_match_case::in,\n core::in, core::out, env::in, env::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\ngather_funcs_expr_case(ast_emc(_, Exprs), !Core, !Env, !Errors) :-\n foldl3(gather_funcs_expr, Exprs, !Core, !Env, !Errors).\n\n%-----------------------------------------------------------------------%\n\n:- func build_param_type(core, env, sharing, ast_param) =\n result(type_, compile_error).\n\nbuild_param_type(Core, Env, Sharing, ast_param(_, Type)) =\n build_type_ref(Core, Env, Sharing, dont_check_type_vars, Type).\n\n:- type check_type_vars\n % Should check that each type variable is in the given set.\n ---> check_type_vars(set(string))\n\n % Don't check, because this type expression is not part of a\n % type declaration.\n ; dont_check_type_vars.\n\n % build_type_ref(Core, Env, ParentSharing, Check, AstType) = Res,\n %\n % Build a type for this ast type expression. If the expression occurs\n % in an exported function declaration then ParentSharing should be\n % s_public.\n %\n:- func build_type_ref(core, env, sharing, check_type_vars, ast_type_expr) =\n result(type_, compile_error).\n\nbuild_type_ref(Core, Env, Sharing, CheckVars, ast_type(Name, Args0, Context)) =\n Result :-\n ArgsResult = result_list_to_result(\n map(build_type_ref(Core, Env, Sharing, CheckVars), Args0)),\n ( ArgsResult = ok(Args),\n ( if env_search_type(Env, Name, Type) then\n ( Type = te_builtin(BuiltinType),\n ( Args0 = [],\n Result = ok(builtin_type(BuiltinType))\n ; Args0 = [_ | _],\n Result = return_error(Context,\n ce_builtin_type_with_args(Name))\n )\n ; Type = te_id(TypeId, TypeArity),\n ( if length(Args) = TypeArity ^ a_num then\n Result = ok(type_ref(TypeId, Args))\n else\n Result = return_error(Context,\n ce_type_has_incorrect_num_of_args(\n Name, TypeArity ^ a_num, length(Args)))\n )\n )\n else\n Result = return_error(Context,\n ce_type_not_known(Name))\n )\n ; ArgsResult = errors(Error),\n Result = errors(Error)\n ).\nbuild_type_ref(Core, Env, Sharing, MaybeCheckVars, Func) = Result :-\n Func = ast_type_func(Args0, Returns0, Uses0, Context),\n ArgsResult = result_list_to_result(\n map(build_type_ref(Core, Env, Sharing, MaybeCheckVars), Args0)),\n ReturnsResult = result_list_to_result(\n map(build_type_ref(Core, Env, Sharing, MaybeCheckVars), Returns0)),\n map_foldl2(build_uses(Context, Env), Uses0,\n ResourceErrorss, set.init, UsesSet, set.init, ObservesSet),\n ResourceErrors = cord_list_to_cord(ResourceErrorss),\n ( if\n ArgsResult = ok(Args),\n ReturnsResult = ok(Returns),\n is_empty(ResourceErrors)\n then\n Result = ok(func_type(Args, Returns, UsesSet, ObservesSet))\n else\n some [!Errors] (\n !:Errors = init,\n add_errors_from_result(ArgsResult, !Errors),\n add_errors_from_result(ReturnsResult, !Errors),\n add_errors(ResourceErrors, !Errors),\n Result = errors(!.Errors)\n )\n ).\nbuild_type_ref(_, _, _, MaybeCheckVars, ast_type_var(Name, Context)) =\n Result :-\n ( if\n MaybeCheckVars = check_type_vars(CheckVars) =>\n member(Name, CheckVars)\n then\n Result = ok(type_variable(Name))\n else\n Result = return_error(Context, ce_type_var_unknown(Name))\n ).\n\n:- pred build_uses(context::in, env::in, ast_uses::in,\n errors(compile_error)::out,\n set(resource_id)::in, set(resource_id)::out,\n set(resource_id)::in, set(resource_id)::out) is det.\n\nbuild_uses(Context, Env, ast_uses(Type, ResourceName), !:Errors,\n !Uses, !Observes) :-\n !:Errors = init,\n ( if env_search_resource(Env, ResourceName, ResourceId) then\n ( Type = ut_uses,\n !:Uses = set.insert(!.Uses, ResourceId)\n ; Type = ut_observes,\n !:Observes = set.insert(!.Observes, ResourceId)\n )\n else\n add_error(Context, ce_resource_unknown(ResourceName), !Errors)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred func_to_pre(env::in, nq_named(ast_function)::in,\n map(func_id, pre_function)::in, map(func_id, pre_function)::out) is det.\n\nfunc_to_pre(Env0, nq_named(Name, Func), !Pre) :-\n Func = ast_function(ast_function_decl(Params, Returns, _, Context),\n Body, _, _),\n ( Body = ast_body_block(Block),\n % The name parameter is the name in the environment and doesn't need to\n % be qualified.\n func_to_pre_func(Env0, q_name(Name), Params, Returns, Block, Context,\n !Pre)\n ; Body = ast_body_foreign(_)\n % Foreign functions skip pre representation.\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func check_resource_exports(core) = errors(compile_error).\n\ncheck_resource_exports(Core) = Errors :-\n Resources = core_all_exported_resources(Core),\n Errors = cord_list_to_cord(\n map(check_resource_exports_2(Core), Resources)).\n\n:- func check_resource_exports_2(core, pair(resource_id, resource)) =\n errors(compile_error).\n\ncheck_resource_exports_2(Core, _ - Res) = Errors :-\n ( Res = r_io,\n Errors = init\n ; Res = r_other(Name, FromId, _, _, Context),\n Errors = check_resource_exports_3(Name, Context, Core, FromId)\n ; Res = r_abstract(_),\n Errors = init\n ).\n\n:- func check_resource_exports_3(q_name, context, core, resource_id) =\n errors(compile_error).\n\ncheck_resource_exports_3(Name, Context, Core, Res) = Errors :-\n resource_is_private(Core, Res) = IsPrivate,\n ( IsPrivate = is_private(RName),\n Errors = error(Context, ce_resource_not_public_in_resource(\n q_name_unqual(Name),\n q_name_unqual(RName)))\n ; IsPrivate = is_not_private,\n Errors = init\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type is_private\n ---> is_private(q_name)\n % could be public, abstract or imported.\n ; is_not_private.\n\n:- func resource_is_private(core, resource_id) = is_private.\n\nresource_is_private(Core, ResId) =\n resource_is_private_2(core_get_resource(Core, ResId)).\n\n:- func resource_is_private_2(resource) = is_private.\n\nresource_is_private_2(r_io) = is_not_private.\nresource_is_private_2(r_other(RName, _, Sharing, Imported, _))\n = Private :-\n ( Sharing = so_public,\n Private = is_not_private\n ; Sharing = so_public_opaque,\n Private = is_not_private\n ; Sharing = so_private,\n ( Imported = i_imported,\n Private = is_not_private\n ; Imported = i_local,\n Private = is_private(RName)\n )\n ).\nresource_is_private_2(r_abstract(_)) = is_not_private.\n\n:- func type_is_private(core, type_id) = is_private.\n\ntype_is_private(Core, TypeId) =\n type_is_private_2(core_get_type(Core, TypeId)).\n\n:- func type_is_private_2(user_type) = is_private.\n\ntype_is_private_2(Type) = Private :-\n Sharing = utype_get_sharing(Type),\n ( Sharing = so_private,\n Imported = utype_get_imported(Type),\n ( Imported = i_imported,\n Private = is_not_private\n ; Imported = i_local,\n Private = is_private(utype_get_name(Type))\n )\n ; Sharing = so_public,\n Private = is_not_private\n ; Sharing = so_public_opaque,\n Private = is_not_private\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func check_type_exports(core) = errors(compile_error).\n\ncheck_type_exports(Core) = Errors :-\n Types = core_all_exported_types(Core),\n Errors = cord_list_to_cord(\n map(check_type_exports_2(Core), Types)).\n\n:- func check_type_exports_2(core, pair(type_id, user_type)) =\n errors(compile_error).\n\ncheck_type_exports_2(Core, _ - Type) = Errors :-\n Sharing = utype_get_sharing(Type),\n ( Sharing = so_public,\n ResourceErrors = cord_list_to_cord(\n map(check_type_resource(Core, Type),\n set.to_sorted_list(utype_get_resources(Core, Type)))),\n TypeErrors = cord_list_to_cord(\n map(check_type_type(Core, Type),\n set.to_sorted_list(utype_get_types(Core, Type)))),\n Errors = ResourceErrors ++ TypeErrors\n ; ( Sharing = so_public_opaque\n ; Sharing = so_private\n ),\n Errors = init\n ).\n\n:- func check_type_resource(core, user_type, resource_id) =\n errors(compile_error).\n\ncheck_type_resource(Core, Type, ResId) = Errors :-\n resource_is_private(Core, ResId) = Private,\n ( Private = is_private(RName),\n Name = utype_get_name(Type),\n Context = utype_get_context(Type),\n Errors = error(Context, ce_resource_not_public_in_type(\n q_name_unqual(Name), q_name_unqual(RName)))\n ; Private = is_not_private,\n Errors = init\n ).\n\n:- func check_type_type(core, user_type, type_id) =\n errors(compile_error).\n\ncheck_type_type(Core, Type, TypeId) = Errors :-\n type_is_private(Core, TypeId) = Private,\n ( Private = is_private(TName),\n Name = utype_get_name(Type),\n Context = utype_get_context(Type),\n Errors = error(Context, ce_type_not_public_in_type(\n q_name_unqual(Name), q_name_unqual(TName)))\n ; Private = is_not_private,\n Errors = init\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func check_function_exports(core) = errors(compile_error).\n\ncheck_function_exports(Core) = Errors :-\n Functions = core_all_exported_functions(Core),\n Errors = cord_list_to_cord(\n map(check_function_exports_2(Core), Functions)).\n\n:- func check_function_exports_2(core, pair(func_id, function)) =\n errors(compile_error).\n\ncheck_function_exports_2(Core, _ - Func) = Errors :-\n func_get_resource_signature(Func, Uses, Observes),\n func_get_type_signature(Func, Params, Returns, _),\n ParamsRes = union_list(map(type_get_resources, Params)),\n ReturnsRes = union_list(map(type_get_resources, Returns)),\n ResIds = set.to_sorted_list(Uses `set.union` Observes `set.union`\n ParamsRes `set.union` ReturnsRes),\n ResErrors = cord_list_to_cord(\n map(check_function_resource(Core, Func), ResIds)),\n TypeIds = set.to_sorted_list(\n union_list(map(type_get_types, Params)) `set.union`\n union_list(map(type_get_types, Returns))),\n TypeErrors = cord_list_to_cord(\n map(check_function_type(Core, Func), TypeIds)),\n Errors = ResErrors ++ TypeErrors.\n\n:- func check_function_resource(core, function, resource_id) =\n errors(compile_error).\n\ncheck_function_resource(Core, Func, ResId) = Errors :-\n resource_is_private(Core, ResId) = Private,\n ( Private = is_private(RName),\n Name = func_get_name(Func),\n Context = func_get_context(Func),\n Errors = error(Context, ce_resource_not_public_in_function(\n q_name_unqual(Name), q_name_unqual(RName)))\n ; Private = is_not_private,\n Errors = init\n ).\n\n:- func check_function_type(core, function, type_id) =\n errors(compile_error).\n\ncheck_function_type(Core, Func, TypeId) = Errors :-\n Private = type_is_private(Core, TypeId),\n ( Private = is_private(TName),\n FName = func_get_name(Func),\n Context = func_get_context(Func),\n Errors = error(Context, ce_type_not_public_in_func(\n q_name_unqual(FName), q_name_unqual(TName)))\n ; Private = is_not_private,\n Errors = init\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.bang.m", "content": "%-----------------------------------------------------------------------%\n% Plasma AST symbol resolution\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module pre.bang.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module compile_error.\n:- import_module core.\n:- import_module pre.pre_ds.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- func check_bangs(core, pre_function) = errors(compile_error).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module cord.\n:- import_module int.\n:- import_module list.\n\n:- import_module context.\n:- import_module common_types.\n\n%-----------------------------------------------------------------------%\n\n% Most of the resource checking is done in a stage after type checking,\n% (core.res_chk.m) so that type information is available for higher-order\n% values. The only check done here is whether there are multiple bangs in a\n% single statement.\n\ncheck_bangs(_Core, Func) =\n cord_list_to_cord(map(check_bangs_stmt, Stmts)) :-\n Stmts = Func ^ f_body.\n\n:- func check_bangs_stmt(pre_statement) = errors(compile_error).\n\ncheck_bangs_stmt(Stmt) = !:Errors :-\n !:Errors = init,\n StmtType = Stmt ^ s_type,\n Context = Stmt ^ s_info ^ si_context,\n ( StmtType = s_call(Call),\n check_bangs_call(Context, Call, ExprsWithBang, StmtErrors),\n add_errors(StmtErrors, !Errors)\n ; StmtType = s_decl_vars(_),\n ExprsWithBang = 0\n ; StmtType = s_assign(_, Exprs),\n map2(check_bangs_expr(Context), Exprs, ExprsWithBangs, StmtErrors),\n ExprsWithBang = sum(ExprsWithBangs),\n add_errors(cord_list_to_cord(StmtErrors), !Errors)\n ; StmtType = s_return(_),\n ExprsWithBang = 0\n ; StmtType = s_match(_, Cases),\n CasesErrors = map(check_bangs_case, Cases),\n ExprsWithBang = 0,\n add_errors(cord_list_to_cord(CasesErrors), !Errors)\n ),\n ( if ExprsWithBang > 1 then\n add_error(Context, ce_too_many_bangs_in_statement, !Errors)\n else\n true\n ).\n\n % This code has been removed because it cannot check higher order code\n % from this pass. And later pases do not carry statement information.\n % It should be re-implemented in the future.\n % ( if\n % all [U] ( member(U, UsedSet) =>\n % (\n % count_value(Used, U, 1),\n % \\+ member(U, ObservedSet),\n % URes = core_get_resource(Info ^ cri_core, U),\n % all [P] ( member(P, UsedSet `union` ObservedSet) =>\n % \\+ (U \\= P, resource_is_decendant(Info ^ cri_core, URes, P))\n % )\n % )\n % ),\n % all [O] ( member(O, ObservedSet) =>\n % (\n % \\+ member(O, UsedSet),\n % ORes = core_get_resource(Info ^ cri_core, O),\n % all [PP] ( member(PP, UsedSet) =>\n % \\+ resource_is_decendant(Info ^ cri_core, ORes, PP)\n % )\n % )\n % )\n % then\n % true\n % else\n % add_error(Context, ce_resource_reused_in_stmt, !Errors)\n % ).\n\n:- func check_bangs_case(pre_case) = errors(compile_error).\n\ncheck_bangs_case(pre_case(_, Stmts)) =\n cord_list_to_cord(map(check_bangs_stmt, Stmts)).\n\n:- pred check_bangs_expr(context::in, pre_expr::in,\n int::out, errors(compile_error)::out) is det.\n\ncheck_bangs_expr(Context, e_call(Call), ExprsWithBang, Errors) :-\n check_bangs_call(Context, Call, ExprsWithBang, Errors).\ncheck_bangs_expr(Context, e_match(Expr, Cases), Bangs, Errors) :-\n check_bangs_expr(Context, Expr, BangsInExpr, ExprErrors),\n map2(check_bangs_expr_case(Context), Cases, BangsInCases, CasesErrors),\n Bangs = sum(BangsInCases) + BangsInExpr,\n Errors = ExprErrors ++ cord_list_to_cord(CasesErrors).\ncheck_bangs_expr(_, e_var(_), 0, init).\ncheck_bangs_expr(Context, e_construction(_, Exprs), Bangs, Errors) :-\n map2(check_bangs_expr(Context), Exprs, BangsInExprs, Errors0),\n Bangs = sum(BangsInExprs),\n Errors = cord_list_to_cord(Errors0).\ncheck_bangs_expr(_, e_lambda(Lambda), 0, Errors) :-\n Body = Lambda ^ pl_body,\n Errors = cord_list_to_cord(map(check_bangs_stmt, Body)).\ncheck_bangs_expr(_, e_constant(_), 0, init).\n\n:- pred check_bangs_call(context::in, pre_call::in, int::out,\n errors(compile_error)::out) is det.\n\ncheck_bangs_call(Context, Call, ExprsWithBang, !:Errors) :-\n !:Errors = init,\n ( Call = pre_call(_, Args, WithBang)\n ; Call = pre_ho_call(_, Args, WithBang)\n ),\n map2(check_bangs_expr(Context), Args, BangsInArgs0, ArgsErrors),\n BangsInArgs = sum(BangsInArgs0),\n add_errors(cord_list_to_cord(ArgsErrors), !Errors),\n ( WithBang = with_bang,\n ExprsWithBang = BangsInArgs + 1\n ; WithBang = without_bang,\n ExprsWithBang = BangsInArgs\n ).\n\n:- pred check_bangs_expr_case(context::in, pre_expr_case::in, int::out,\n errors(compile_error)::out) is det.\n\ncheck_bangs_expr_case(Context, pre_e_case(_, Expr), Bangs, Errors) :-\n map2(check_bangs_expr(Context), Expr, Bangss, Errorss),\n Bangs = sum(Bangss),\n Errors = cord_list_to_cord(Errorss).\n\n%-----------------------------------------------------------------------%\n\n:- func sum(list(int)) = int.\n\nsum(Xs) = foldl(func(A, B) = A + B, Xs, 0).\n\n" }, { "path": "src/pre.branches.m", "content": "%-----------------------------------------------------------------------%\n% Plasma AST symbol resolution\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module fixes variable usage in branching code. It:\n% * fixes var-def sets\n% * Determines some reachability information (WRT return statements).\n% * checks that used variables are always well defined (eg\n% along all execution paths)\n% * names-appart branch-local variables (from other\n% branches).\n%\n%-----------------------------------------------------------------------%\n:- module pre.branches.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module compile_error.\n:- import_module pre.pre_ds.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- func fix_branches(pre_function) =\n result(pre_function, compile_error).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module list.\n:- import_module require.\n:- import_module set.\n\n:- import_module context.\n:- import_module common_types.\n:- import_module pre.util.\n:- import_module util.my_exception.\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\nfix_branches(!.Func) = Result :-\n Stmts0 = !.Func ^ f_body,\n Varmap0 = !.Func ^ f_varmap,\n Arity = !.Func ^ f_arity,\n Context = !.Func ^ f_context,\n map_foldl3(fix_branches_stmt, Stmts0, Stmts1, set.init, _,\n Varmap0, Varmap, init, BranchesErrors),\n ( if is_empty(BranchesErrors) then\n ResultStmts = fix_return_stmt(return_info(Context, Arity), Stmts1),\n ( ResultStmts = ok(Stmts),\n !Func ^ f_body := Stmts,\n !Func ^ f_varmap := Varmap,\n Result = ok(!.Func)\n ; ResultStmts = errors(Errors),\n Result = errors(Errors)\n )\n else\n Result = errors(BranchesErrors)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred fix_branches_stmt(pre_statement::in, pre_statement::out,\n set(var)::in, set(var)::out, varmap::in, varmap::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\nfix_branches_stmt(!Stmt, !DeclVars, !Varmap, !Errors) :-\n Context = !.Stmt ^ s_info ^ si_context,\n update_lambdas_this_stmt_2(fix_branches_lambda(Context),\n !Stmt, !Varmap, !Errors),\n Type = !.Stmt ^ s_type,\n % Only defined vars that are also non-local can be defined vars.\n (\n ( Type = s_call(_)\n ; Type = s_assign(_, _)\n ; Type = s_return(_)\n )\n ;\n Type = s_decl_vars(NewDeclVars),\n !:DeclVars = !.DeclVars `union` list_to_set(NewDeclVars)\n ;\n Type = s_match(Var, Cases0),\n\n Info = !.Stmt ^ s_info,\n DefVars = Info ^ si_def_vars,\n UsedDefVars = DefVars `intersect` !.DeclVars,\n map2_foldl3(fix_branches_case(!.DeclVars, UsedDefVars), Cases0,\n Cases, CasesReachable, set.init, _, !Varmap, !Errors),\n Reachable = reachable_branches(CasesReachable),\n\n !Stmt ^ s_type := s_match(Var, Cases),\n\n % Fixup variable sets. These sets are more strict but they also\n % allow us to avoid doing any renaming here, since renaming only\n % occurs for local variables.\n UseVars0 = Info ^ si_use_vars,\n UseVars = UseVars0 `intersect` !.DeclVars,\n\n !Stmt ^ s_info := ((Info ^ si_use_vars := UseVars)\n ^ si_reachable := Reachable)\n ).\n\n:- type binds_vars\n ---> binds_vars(set(var))\n ; not_reached.\n\n:- pred fix_branches_case(set(var)::in, set(var)::in,\n pre_case::in, pre_case::out, stmt_reachable::out,\n set(var)::in, set(var)::out, varmap::in, varmap::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\nfix_branches_case(DeclVars, SwitchDefVars, pre_case(Pat, Stmts0),\n pre_case(Pat, Stmts), Reachable, !CasesVars, !Varmap, !Errors) :-\n map_foldl3(fix_branches_stmt, Stmts0, Stmts, DeclVars, _, !Varmap,\n !Errors),\n\n PatVars = pattern_all_vars(Pat),\n\n StmtsDefVars = union_list(map((func(S) = S ^ s_info ^ si_def_vars),\n Stmts)),\n Reachable = reachable_sequence(\n map((func(S) = S ^ s_info ^ si_reachable), Stmts)),\n (\n Reachable = stmt_always_returns\n ;\n ( Reachable = stmt_always_fallsthrough\n ; Reachable = stmt_may_return\n ),\n DefVars = StmtsDefVars `union` PatVars,\n ( if not superset(DefVars, SwitchDefVars) then\n ( Stmts0 = [HeadStmt | _],\n Context = HeadStmt ^ s_info ^ si_context\n ; Stmts0 = [],\n unexpected($file, $pred, \"Empty case\")\n ),\n MissedVars = map(get_var_name_no_suffix(!.Varmap),\n to_sorted_list(difference(SwitchDefVars, DefVars))),\n add_error(Context,\n ce_case_does_not_define_all_variables(MissedVars), !Errors)\n else\n true\n )\n ),\n\n AllVars = union_list(map(stmt_all_vars, Stmts)),\n !:CasesVars = !.CasesVars `union` AllVars.\n\n:- func reachable_branches(list(stmt_reachable)) = stmt_reachable.\n\nreachable_branches([]) = stmt_always_fallsthrough.\nreachable_branches([R | Rs]) =\n foldl(reachable_branches_2, Rs, R).\n\n:- func reachable_branches_2(stmt_reachable, stmt_reachable) =\n stmt_reachable.\n\nreachable_branches_2(stmt_may_return, _) = stmt_may_return.\nreachable_branches_2(stmt_always_fallsthrough, stmt_always_fallsthrough) =\n stmt_always_fallsthrough.\nreachable_branches_2(stmt_always_fallsthrough, stmt_always_returns) =\n stmt_may_return.\nreachable_branches_2(stmt_always_fallsthrough, stmt_may_return) =\n stmt_may_return.\nreachable_branches_2(stmt_always_returns, stmt_always_returns) =\n stmt_always_returns.\nreachable_branches_2(stmt_always_returns, stmt_always_fallsthrough) =\n stmt_may_return.\nreachable_branches_2(stmt_always_returns, stmt_may_return) =\n stmt_may_return.\n\n:- func reachable_sequence(list(stmt_reachable)) = stmt_reachable.\n\nreachable_sequence(Branches) =\n foldl(reachable_sequence_2, Branches, stmt_always_fallsthrough).\n\n:- func reachable_sequence_2(stmt_reachable, stmt_reachable) = stmt_reachable.\n\nreachable_sequence_2(stmt_always_fallsthrough, R) = R.\nreachable_sequence_2(stmt_always_returns, _) = stmt_always_returns.\nreachable_sequence_2(stmt_may_return, stmt_always_fallsthrough) =\n stmt_may_return.\nreachable_sequence_2(stmt_may_return, stmt_always_returns) =\n stmt_always_returns.\nreachable_sequence_2(stmt_may_return, stmt_may_return) =\n stmt_may_return.\n\n%-----------------------------------------------------------------------%\n\n:- pred fix_branches_lambda(context::in,\n pre_lambda::in, pre_lambda::out, varmap::in, varmap::out,\n errors(compile_error)::in, errors(compile_error)::out) is det.\n\nfix_branches_lambda(Context, !Lambda, !Varmap, !Errors) :-\n some [!Body] (\n !.Lambda = pre_lambda(Func, Params, Captured, Arity, !:Body),\n map_foldl3(fix_branches_stmt, !Body, set.init, _, !Varmap, !Errors),\n ResultStmts = fix_return_stmt(return_info(Context, Arity), !.Body),\n ( ResultStmts = ok(!:Body),\n !:Lambda = pre_lambda(Func, Params, Captured, Arity, !.Body)\n ; ResultStmts = errors(Errors),\n add_errors(Errors, !Errors)\n )\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type return_info\n ---> return_info(\n ri_context :: context,\n ri_arity :: arity\n ).\n\n:- func fix_return_stmt(return_info, pre_statements) =\n result(pre_statements, compile_error).\n\nfix_return_stmt(Info, Stmts0) =\n result_map(reverse, fix_return_stmt_rev(Info, reverse(Stmts0))).\n\n:- func fix_return_stmt_rev(return_info, pre_statements) =\n result(pre_statements, compile_error).\n\nfix_return_stmt_rev(Info, []) = check_arity_and_return(Context, Arity) :-\n return_info(Context, Arity) = Info.\nfix_return_stmt_rev(Info, [Stmt0 | Stmts0]) = Result :-\n Reachable = Stmt0 ^ s_info ^ si_reachable,\n ( Reachable = stmt_always_returns,\n Result = ok([Stmt0 | Stmts0])\n ; Reachable = stmt_always_fallsthrough,\n Context = Stmt0 ^ s_info ^ si_context,\n Arity = Info ^ ri_arity,\n Result0 = check_arity_and_return(Context, Arity),\n Result = result_map((func(R) = R ++ [Stmt0 | Stmts0]), Result0)\n ; Reachable = stmt_may_return,\n Type = Stmt0 ^ s_type,\n ( Type = s_match(Var, Cases0),\n CasesResult = result_list_to_result(\n map(fix_return_stmt_case(Info), Cases0)),\n Result = result_map(\n (func(Cases) = [Stmt | Stmts0] :-\n Stmt = Stmt0 ^ s_type := s_match(Var, Cases)\n ),\n CasesResult)\n ;\n ( Type = s_call(_)\n ; Type = s_decl_vars(_)\n ; Type = s_assign(_, _)\n ; Type = s_return(_)\n ),\n unexpected($file, $pred, \"Impercise reachablity\")\n )\n ).\n\n:- func fix_return_stmt_case(return_info, pre_case) =\n result(pre_case, compile_error).\n\nfix_return_stmt_case(Info, pre_case(Pat, Stmts0)) = Result :-\n ResultStmts = fix_return_stmt(Info, Stmts0),\n Result = result_map(\n (func(Stmts) =\n pre_case(Pat, Stmts)\n ), ResultStmts).\n\n:- func check_arity_and_return(context, arity) =\n result(pre_statements, compile_error).\n\ncheck_arity_and_return(Context, Arity) = Result :-\n ( if Arity = arity(0) then\n Result = ok([new_return_statement])\n else\n Result = return_error(Context, ce_no_return_statement(Arity))\n ).\n\n:- func new_return_statement = pre_statement.\n\nnew_return_statement = pre_statement(s_return([]), Info) :-\n Info = stmt_info(nil_context, init, init, stmt_always_returns).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.closures.m", "content": "%-----------------------------------------------------------------------%\n% Plasma AST symbol resolution\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module computes nonlocals within the pre-core representation.\n%\n%-----------------------------------------------------------------------%\n:- module pre.closures.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module pre.pre_ds.\n\n%-----------------------------------------------------------------------%\n\n:- pred compute_closures(pre_function::in, pre_function::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module maybe.\n:- import_module list.\n:- import_module require.\n:- import_module set.\n\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\ncompute_closures(!Func) :-\n Stmts0 = !.Func ^ f_body,\n filter_map(vow_is_var, !.Func ^ f_param_vars, Params),\n map_foldl(compute_closures_stmt, Stmts0, Stmts, list_to_set(Params), _),\n !Func ^ f_body := Stmts.\n\n:- pred compute_closures_stmt(pre_statement::in, pre_statement::out,\n set(var)::in, set(var)::out) is det.\n\ncompute_closures_stmt(!Stmt, !DeclVars) :-\n !.Stmt = pre_statement(Type, Info),\n ( Type = s_call(Call0),\n compute_closures_call(!.DeclVars, Call0, Call),\n !:Stmt = pre_statement(s_call(Call), Info)\n ; Type = s_decl_vars(Vars),\n !:DeclVars = !.DeclVars `union` list_to_set(Vars)\n ; Type = s_assign(Vars, Exprs0),\n map(compute_closures_expr(!.DeclVars), Exprs0, Exprs),\n !:Stmt = pre_statement(s_assign(Vars, Exprs), Info)\n ; Type = s_return(_)\n ; Type = s_match(Var, Cases0),\n map(compute_closures_case(!.DeclVars), Cases0, Cases),\n !:Stmt = pre_statement(s_match(Var, Cases), Info)\n ).\n\n:- pred compute_closures_case(set(var)::in, pre_case::in, pre_case::out) is det.\n\ncompute_closures_case(DeclVars, pre_case(Pat, Stmts0), pre_case(Pat, Stmts)) :-\n map_foldl(compute_closures_stmt, Stmts0, Stmts,\n DeclVars `union` pattern_all_vars(Pat), _).\n\n:- pred compute_closures_call(set(var)::in, pre_call::in, pre_call::out) is det.\n\ncompute_closures_call(DeclVars,\n pre_call(Func, Args0, Bang), pre_call(Func, Args, Bang)) :-\n map(compute_closures_expr(DeclVars), Args0, Args).\ncompute_closures_call(DeclVars,\n pre_ho_call(Callee0, Args0, Bang), pre_ho_call(Callee, Args, Bang)) :-\n compute_closures_expr(DeclVars, Callee0, Callee),\n map(compute_closures_expr(DeclVars), Args0, Args).\n\n:- pred compute_closures_expr(set(var)::in, pre_expr::in, pre_expr::out) is det.\n\ncompute_closures_expr(DeclVars, e_call(Call0), e_call(Call)) :-\n compute_closures_call(DeclVars, Call0, Call).\ncompute_closures_expr(DeclVars, e_match(Expr0, Cases0), e_match(Expr, Cases)) :-\n compute_closures_expr(DeclVars, Expr0, Expr),\n map(compute_closures_e_case(DeclVars), Cases0, Cases).\ncompute_closures_expr(_, e_var(V), e_var(V)).\ncompute_closures_expr(DeclVars, e_construction(Ctors, Args0),\n e_construction(Ctors, Args)) :-\n map(compute_closures_expr(DeclVars), Args0, Args).\ncompute_closures_expr(DeclVars, e_lambda(Lambda0), e_lambda(Lambda)) :-\n compute_closures_lambda(DeclVars, Lambda0, Lambda).\ncompute_closures_expr(_, e_constant(C), e_constant(C)).\n\n:- pred compute_closures_e_case(set(var)::in,\n pre_expr_case::in, pre_expr_case::out) is det.\n\ncompute_closures_e_case(DeclVars,\n pre_e_case(Pat, Exprs0), pre_e_case(Pat, Exprs)) :-\n map(compute_closures_expr(DeclVars `union` pattern_all_vars(Pat)),\n Exprs0, Exprs).\n\n:- pred compute_closures_lambda(set(var)::in,\n pre_lambda::in, pre_lambda::out) is det.\n\ncompute_closures_lambda(DeclVars, !Lambda) :-\n MaybeCaptured = !.Lambda ^ pl_captured,\n ( MaybeCaptured = no\n ; MaybeCaptured = yes(_),\n unexpected($file, $pred, \"Expect MaybeCaptured = no\")\n ),\n map_foldl(compute_closures_stmt, !.Lambda ^ pl_body, Body,\n DeclVars `union` list_to_set(ParamVars), _),\n % We have to capture this information from within the lambda, if we got\n % it from outside it could be confused with other expressions within the\n % same statement.\n DefVars = union_list(map(func(S) = S ^ s_info ^ si_def_vars, Body)),\n UseVars = union_list(map(func(S) = S ^ s_info ^ si_use_vars, Body)),\n filter_map(vow_is_var, !.Lambda ^ pl_params, ParamVars),\n Captured = (UseVars `intersect` DeclVars) `difference` DefVars\n `difference` list_to_set(ParamVars),\n !Lambda ^ pl_captured := yes(Captured),\n !Lambda ^ pl_body := Body.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.env.m", "content": "%-----------------------------------------------------------------------%\n% Plasma AST Environment manipulation routines\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module contains code to track the environment of a statement in the\n% Plasma AST.\n%\n%-----------------------------------------------------------------------%\n:- module pre.env.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module set.\n:- import_module string.\n\n:- import_module ast.\n:- import_module context.\n:- import_module common_types.\n:- import_module core.\n:- import_module core.types.\n:- import_module q_name.\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\n:- type env.\n\n % init(Operators) = Env.\n %\n:- func init(operators) = env.\n\n % Sometimes we need to look up particular operators and constructors,\n % when we do this we know exactly which constroctor and don't need to\n % use the normal name resolution.\n %\n:- type operators\n ---> operators(\n o_int_add :: func_id,\n o_int_sub :: func_id,\n o_int_mul :: func_id,\n o_int_div :: func_id,\n o_int_mod :: func_id,\n o_int_gt :: func_id,\n o_int_lt :: func_id,\n o_int_gteq :: func_id,\n o_int_lteq :: func_id,\n o_int_eq :: func_id,\n o_int_neq :: func_id,\n\n % Unary minus\n o_int_minus :: func_id,\n\n % We need to lookup bool constructors for generating ITE\n % code.\n o_bool_true :: ctor_id,\n o_bool_false :: ctor_id,\n o_bool_and :: func_id,\n o_bool_or :: func_id,\n o_bool_not :: func_id,\n\n % We need to lookup list constructors to handle built in\n % list syntax.\n o_list_type :: type_id,\n o_list_nil :: ctor_id,\n o_list_cons :: ctor_id,\n\n o_string_concat :: func_id\n ).\n\n:- func env_operators(env) = operators.\n\n%-----------------------------------------------------------------------%\n%\n% Code to add variables and maniuplate their visibility in the environment.\n%\n\n % Add but leave a variable uninitialised.\n %\n % The variable must not already exist.\n %\n:- pred env_add_uninitialised_var(string::in, var::out, env::in, env::out,\n varmap::in, varmap::out) is semidet.\n\n % Add and initialise a variable.\n %\n % The variable must not already exist.\n %\n:- pred env_add_and_initlalise_var(string::in, var::out, env::in, env::out,\n varmap::in, varmap::out) is semidet.\n\n:- type initialise_result(T)\n ---> ok(T)\n ; does_not_exist\n ; already_initialised\n ; inaccessible.\n\n % Initialise an existing variable.\n %\n % The variable must already exist.\n %\n:- pred env_initialise_var(string::in, initialise_result(var)::out,\n env::in, env::out, varmap::in, varmap::out) is det.\n\n % All the vars that are defined but not initialised.\n %\n:- func env_uninitialised_vars(env) = set(var).\n\n % Mark all these uninitialised vars as initialised.\n %\n:- pred env_mark_initialised(set(var)::in, env::in, env::out) is det.\n\n % Within a closure scope the currently-uninitialised variables cannot be\n % accessed from the closure.\n %\n % We leave closures (like any scope) by discarding the environment and\n % using a \"higher\" one.\n %\n:- pred env_enter_closure(env::in, env::out) is det.\n\n % Add a letrec variable.\n %\n % These are added to help resolve names within nested functions.\n % They're cleared when the real variable bindings become available.\n % Discarding is performed by discarding the environment.\n %\n:- pred env_add_for_letrec(string::in, var::out, env::in, env::out,\n varmap::in, varmap::out) is semidet.\n\n % Within a letrec temporally set a self-recursive reference to a direct\n % function call. This is how we handle self-recursion, which works\n % because its the same environment.\n %\n:- pred env_letrec_self_recursive(string::in, func_id::in,\n env::in, env::out) is det.\n\n % Mark the formerly-letrec variable as a fully defined variable, because\n % it has now been defined while processing the letrec.\n %\n:- pred env_letrec_defined(string::in, env::in, env::out) is det.\n\n % Make all letrec variables initalised (we've finished building the\n % letrec).\n %\n:- pred env_leave_letrec(env::in, env::out) is det.\n\n%-----------------------------------------------------------------------%\n%\n% Code to add other symbols to the environment.\n%\n\n:- pred env_add_func(q_name::in, func_id::in, env::in, env::out) is semidet.\n\n % Used to add builtins, which always have unique names.\n %\n:- pred env_add_func_det(q_name::in, func_id::in, env::in, env::out) is det.\n\n:- pred env_add_type(q_name::in, arity::in, type_id::in, env::in, env::out)\n is semidet.\n\n:- pred env_add_type_det(q_name::in, arity::in, type_id::in, env::in, env::out)\n is det.\n\n:- pred env_add_builtin_type_det(q_name::in, builtin_type::in,\n env::in, env::out) is det.\n\n % Constructors may be overloaded, unlike other symbols, this predicate\n % will add this constructor ID to the set of constructor IDs that this\n % name may be referring to. If the name is already bound to something\n % else, it throws an exception.\n %\n:- pred env_add_constructor(q_name::in, ctor_id::in, env::in, env::out)\n is det.\n\n:- pred env_add_resource(q_name::in, resource_id::in, env::in, env::out)\n is semidet.\n\n:- pred env_add_resource_det(q_name::in, resource_id::in, env::in, env::out)\n is det.\n\n%-----------------------------------------------------------------------%\n%\n% Code to query the environment.\n%\n\n:- type env_entry\n ---> ee_var(var)\n ; ee_func(func_id)\n ; ee_constructor(set(ctor_id)).\n\n:- inst env_entry_func_or_ctor for env_entry/0\n ---> ee_func(ground)\n ; ee_constructor(ground).\n\n:- type env_search_result(T)\n ---> ok(T)\n ; not_found\n ; not_initaliased\n ; inaccessible\n ; maybe_cyclic_retlec.\n\n:- pred env_search(env::in, q_name::in, env_search_result(env_entry)::out)\n is det.\n\n % Throws an exception if the entry doesn't exist or isn't a function.\n %\n:- pred env_lookup_function(env::in, q_name::in, func_id::out) is det.\n\n:- type type_entry\n ---> te_builtin(\n te_builtin :: builtin_type\n )\n ; te_id(\n te_id :: type_id,\n te_arity :: arity\n ).\n\n:- pred env_search_type(env::in, q_name::in, type_entry::out) is semidet.\n\n:- pred env_lookup_type(env::in, q_name::in, type_entry::out) is det.\n\n:- pred env_search_constructor(env::in, q_name::in, set(ctor_id)::out)\n is semidet.\n\n % NOTE: This is currently only implemented for one data type per\n % operator.\n %\n:- pred env_operator_entry(env, ast_bop, env_entry).\n:- mode env_operator_entry(in, in, out(env_entry_func_or_ctor)) is det.\n\n:- func env_unary_operator_func(env, ast_uop) = func_id.\n\n:- pred env_search_resource(env::in, q_name::in, resource_id::out)\n is semidet.\n\n:- pred env_lookup_resource(env::in, q_name::in, resource_id::out) is det.\n\n%-----------------------------------------------------------------------%\n%\n% Misc.\n%\n\n % Make a mangled name for a lambda.\n %\n:- func mangle_lambda(string, context) = string.\n\n % A name->func_id mapping is tracked in the environment. These aren't\n % actual name bindings in the Plasma language, and env_search won't find\n % them. It's just convenient to put them in this data structure since\n % they're added at the top level and not needed after the pre-core\n % compilation stage.\n %\n % This is different from the letrec entries added above.\n %\n:- pred env_add_lambda(string::in, func_id::in, env::in, env::out) is det.\n\n:- pred env_lookup_lambda(env::in, string::in, func_id::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- pred do_var_or_wildcard(pred(X, Y, A, A, B, B),\n var_or_wildcard(X), var_or_wildcard(Y), A, A, B, B).\n:- mode do_var_or_wildcard(pred(in, out, in, out, in, out) is det,\n in, out, in, out, in, out) is det.\n:- mode do_var_or_wildcard(pred(in, out, in, out, in, out) is semidet,\n in, out, in, out, in, out) is semidet.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module list.\n:- import_module map.\n:- import_module maybe.\n:- import_module require.\n:- import_module util.\n:- import_module util.my_exception.\n\n:- import_module builtins.\n\n%-----------------------------------------------------------------------%\n\n % TODO, use a radix structure. Lookup errors can be more informative.\n %\n:- type env\n ---> env(\n e_map :: map(q_name, env_entry),\n e_typemap :: map(q_name, type_entry),\n e_resmap :: map(q_name, resource_id),\n e_lambdas :: map(string, func_id),\n\n % The set of uninitialised variables\n e_uninitialised :: set(var),\n\n % The set of letrec variables, they're also uninitialised but\n % their definition may be recursive and so we don't generate\n % an error as we do for uninitialised ones.\n e_letrec_vars :: set(var),\n\n % Uninitalised variables outside this closure.\n e_inaccessible :: set(var),\n\n e_operators :: operators\n ).\n\n%-----------------------------------------------------------------------%\n\ninit(Operators) =\n env(init, init, init, init, init, init, init, Operators).\n\nenv_operators(Env) = Env ^ e_operators.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\nenv_add_uninitialised_var(Name, Var, !Env, !Varmap) :-\n env_add_var(Name, Var, !Env, !Varmap),\n !Env ^ e_uninitialised := insert(!.Env ^ e_uninitialised, Var).\n\nenv_add_and_initlalise_var(Name, Var, !Env, !Varmap) :-\n env_add_var(Name, Var, !Env, !Varmap).\n\n:- pred env_add_var(string::in, var::out, env::in, env::out,\n varmap::in, varmap::out) is semidet.\n\nenv_add_var(Name, Var, !Env, !Varmap) :-\n ( if Name = \"_\" then\n unexpected($file, $pred, \"Wildcard string as varname\")\n else\n add_fresh_var(Name, Var, !Varmap),\n insert(q_name_single(Name), ee_var(Var), !.Env ^ e_map, Map),\n !Env ^ e_map := Map\n ).\n\nenv_initialise_var(Name, Result, !Env, !Varmap) :-\n ( if Name = \"_\" then\n unexpected($file, $pred, \"Windcard string as varname\")\n else\n ( if search(!.Env ^ e_map, q_name_single(Name), ee_var(Var))\n then\n ( if remove(Var, !.Env ^ e_uninitialised, Uninitialised) then\n !Env ^ e_uninitialised := Uninitialised,\n Result = ok(Var)\n else if member(Var, !.Env ^ e_inaccessible) then\n Result = inaccessible\n else if member(Var, !.Env ^ e_letrec_vars) then\n unexpected($file, $pred,\n \"Cannot set letrec variables this way\")\n else\n Result = already_initialised\n )\n else\n Result = does_not_exist\n )\n ).\n\n%-----------------------------------------------------------------------%\n\nenv_uninitialised_vars(Env) = Env ^ e_uninitialised.\n\nenv_mark_initialised(Vars, !Env) :-\n !Env ^ e_uninitialised := !.Env ^ e_uninitialised `difference` Vars.\n\nenv_enter_closure(!Env) :-\n !Env ^ e_inaccessible := !.Env ^ e_uninitialised,\n !Env ^ e_uninitialised := set.init.\n\n%-----------------------------------------------------------------------%\n\nenv_add_for_letrec(Name, Var, !Env, !Varmap) :-\n env_add_var(Name, Var, !Env, !Varmap),\n !Env ^ e_letrec_vars := insert(!.Env ^ e_letrec_vars, Var).\n\nenv_letrec_self_recursive(Name, FuncId, !Env) :-\n lookup(!.Env ^ e_map, q_name_single(Name), Entry),\n ( Entry = ee_var(Var),\n det_update(q_name_single(Name), ee_func(FuncId), !.Env ^ e_map, Map),\n !Env ^ e_map := Map,\n det_remove(Var, !.Env ^ e_letrec_vars, LetrecVars),\n !Env ^ e_letrec_vars := LetrecVars\n ;\n ( Entry = ee_func(_)\n ; Entry = ee_constructor(_)\n ),\n unexpected($file, $pred, \"Entry is not a variable\")\n ).\n\nenv_letrec_defined(Name, !Env) :-\n lookup(!.Env ^ e_map, q_name_single(Name), Entry),\n ( Entry = ee_var(Var),\n det_remove(Var, !.Env ^ e_letrec_vars, LetrecVars),\n !Env ^ e_letrec_vars := LetrecVars\n ;\n ( Entry = ee_func(_)\n ; Entry = ee_constructor(_)\n ),\n unexpected($file, $pred, \"Not a variable\")\n ).\n\nenv_leave_letrec(!Env) :-\n ( if not is_empty(!.Env ^ e_letrec_vars) then\n !Env ^ e_letrec_vars := set.init\n else\n unexpected($file, $pred, \"Letrec had no variables\")\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\nenv_add_func(Name, Func, !Env) :-\n insert(Name, ee_func(Func), !.Env ^ e_map, Map),\n !Env ^ e_map := Map.\n\nenv_add_func_det(Name, Func, !Env) :-\n ( if env_add_func(Name, Func, !Env) then\n true\n else\n unexpected($file, $pred, \"Function already exists\")\n ).\n\n%-----------------------------------------------------------------------%\n\nenv_add_type(Name, Arity, Type, !Env) :-\n insert(Name, te_id(Type, Arity), !.Env ^ e_typemap, Map),\n !Env ^ e_typemap := Map.\n\nenv_add_type_det(Name, Arity, Type, !Env) :-\n ( if env_add_type(Name, Arity, Type, !Env) then\n true\n else\n unexpected($file, $pred, \"Type already defined\")\n ).\n\nenv_add_builtin_type_det(Name, Builtin, !Env) :-\n map.det_insert(Name, te_builtin(Builtin), !.Env ^ e_typemap, Map),\n !Env ^ e_typemap := Map.\n\n%-----------------------------------------------------------------------%\n\nenv_add_constructor(Name, Cons, !Env) :-\n some [!Map] (\n !:Map = !.Env ^ e_map,\n ( if search(!.Env ^ e_map, Name, Entry) then\n ( Entry = ee_constructor(ConsSet0),\n ConsSet = insert(ConsSet0, Cons),\n det_update(Name, ee_constructor(ConsSet), !Map)\n ;\n ( Entry = ee_var(_)\n ; Entry = ee_func(_)\n ),\n unexpected($file, $pred,\n \"name already exists as non-constructor\")\n )\n else\n det_insert(Name, ee_constructor(make_singleton_set(Cons)), !Map)\n ),\n !Env ^ e_map := !.Map\n ).\n\n%-----------------------------------------------------------------------%\n\nenv_add_resource(Name, ResId, !Env) :-\n insert(Name, ResId, !.Env ^ e_resmap, Map),\n !Env ^ e_resmap := Map.\n\nenv_add_resource_det(Name, ResId, !Env) :-\n det_insert(Name, ResId, !.Env ^ e_resmap, Map),\n !Env ^ e_resmap := Map.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\nenv_search(Env, QName, Result) :-\n ( if search(Env ^ e_map, QName, Entry) then\n ( Entry = ee_var(Var),\n ( if member(Var, Env ^ e_inaccessible) then\n Result = inaccessible\n else if member(Var, Env ^ e_uninitialised) then\n Result = not_initaliased\n else if member(Var, Env ^ e_letrec_vars) then\n Result = maybe_cyclic_retlec\n else\n Result = ok(Entry)\n )\n ;\n ( Entry = ee_func(_)\n ; Entry = ee_constructor(_)\n ),\n Result = ok(Entry)\n )\n else\n Result = not_found\n ).\n\nenv_lookup_function(Env, QName, FuncId) :-\n ( if env_search(Env, QName, ok(ee_func(FuncIdPrime))) then\n FuncId = FuncIdPrime\n else\n unexpected($file, $pred, \"Entry not found or not a function\")\n ).\n\nenv_search_type(Env, QName, Type) :-\n search(Env ^ e_typemap, QName, Type).\n\nenv_lookup_type(Env, QName, Type) :-\n ( if env_search_type(Env, QName, TypePrime) then\n Type = TypePrime\n else\n unexpected($file, $pred, \"Type not found\")\n ).\n\nenv_search_constructor(Env, QName, CtorId) :-\n env_search(Env, QName, ok(ee_constructor(CtorId))).\n\n%-----------------------------------------------------------------------%\n\nenv_operator_entry(Env, Op, Entry) :-\n Ops = env_operators(Env),\n (\n ( Op = b_add,\n Func = Ops ^ o_int_add\n ; Op = b_sub,\n Func = Ops ^ o_int_sub\n ; Op = b_mul,\n Func = Ops ^ o_int_mul\n ; Op = b_div,\n Func = Ops ^ o_int_div\n ; Op = b_mod,\n Func = Ops ^ o_int_mod\n ; Op = b_gt,\n Func = Ops ^ o_int_gt\n ; Op = b_lt,\n Func = Ops ^ o_int_lt\n ; Op = b_gteq,\n Func = Ops ^ o_int_gteq\n ; Op = b_lteq,\n Func = Ops ^ o_int_lteq\n ; Op = b_eq,\n Func = Ops ^ o_int_eq\n ; Op = b_neq,\n Func = Ops ^ o_int_neq\n ; Op = b_logical_and,\n Func = Ops ^ o_bool_and\n ; Op = b_logical_or,\n Func = Ops ^ o_bool_or\n ; Op = b_concat,\n Func = Ops ^ o_string_concat\n ),\n Entry = ee_func(Func)\n ; Op = b_list_cons,\n Entry = ee_constructor(make_singleton_set(Ops ^ o_list_cons))\n ; Op = b_array_subscript,\n my_exception.sorry($file, $pred, \"Array subscript\")\n ).\n\nenv_unary_operator_func(Env, UOp) = FuncId :-\n Ops = env_operators(Env),\n ( UOp = u_minus,\n FuncId = Ops ^ o_int_minus\n ; UOp = u_not,\n FuncId = Ops ^ o_bool_not\n ).\n\n%-----------------------------------------------------------------------%\n\nenv_search_resource(Env, QName, ResId) :-\n search(Env ^ e_resmap, QName, ResId).\n\nenv_lookup_resource(Env, QName, ResId) :-\n lookup(Env ^ e_resmap, QName, ResId).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\nmangle_lambda(Name, context(_, Line, Col)) =\n string.format(\"lambda_l%d_%s_c%d\", [i(Line), s(Name), i(Col)]).\n\nenv_add_lambda(Name, FuncId, !Env) :-\n det_insert(Name, FuncId, !.Env ^ e_lambdas, Lambdas),\n !Env ^ e_lambdas := Lambdas.\n\nenv_lookup_lambda(Env, Name, FuncId) :-\n lookup(Env ^ e_lambdas, Name, FuncId).\n\n%-----------------------------------------------------------------------%\n\ndo_var_or_wildcard(Pred, var(Name), var(Var), !Env, !Varmap) :-\n Pred(Name, Var, !Env, !Varmap).\ndo_var_or_wildcard(_, wildcard, wildcard, !Env, !Varmap).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.from_ast.m", "content": "%-----------------------------------------------------------------------%\n% Plasma AST symbol resolution\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module resolves symbols within the Plasma AST returning the pre-core\n% representation.\n%\n%-----------------------------------------------------------------------%\n:- module pre.from_ast.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module list.\n:- import_module map.\n\n:- import_module ast.\n:- import_module context.\n:- import_module common_types.\n:- import_module pre.env.\n:- import_module pre.pre_ds.\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\n:- pred func_to_pre_func(env::in, q_name::in, list(ast_param)::in,\n list(ast_type_expr)::in, list(ast_block_thing)::in, context::in,\n map(func_id, pre_function)::in, map(func_id, pre_function)::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module maybe.\n:- import_module pair.\n:- import_module require.\n:- import_module set.\n:- import_module string.\n\n:- import_module util.\n:- import_module util.my_exception.\n:- import_module util.mercury.\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\nfunc_to_pre_func(Env, Name, Params, Returns, Body0, Context, !Pre) :-\n % Build body.\n some [!Varmap] (\n !:Varmap = varmap.init,\n env_lookup_function(Env, Name, FuncId),\n Arity = arity(length(Returns)),\n ast_to_pre_body(Env, Context, Arity, Params, ParamVarsOrWildcards,\n Body0, Body, _, !Varmap),\n Func = pre_function(FuncId, !.Varmap, ParamVarsOrWildcards,\n Arity, Body, Context),\n map.det_insert(FuncId, Func, !Pre)\n ).\n\n:- pred ast_to_pre_body(env::in, context::in, arity::in,\n list(ast_param)::in, list(var_or_wildcard(var))::out,\n list(ast_block_thing(context))::in, pre_statements::out,\n set(var)::out, varmap::in, varmap::out) is det.\n\nast_to_pre_body(Env0, Context, Arity, Params, ParamVarsOrWildcards,\n Body0, Body, UseVars, !Varmap) :-\n ParamNames = map((func(ast_param(N, _)) = N), Params),\n ( if\n map_foldl2(do_var_or_wildcard(env_add_and_initlalise_var),\n ParamNames, ParamVarsOrWildcardsPrime, Env0, EnvPrime,\n !Varmap)\n then\n ParamVarsOrWildcards = ParamVarsOrWildcardsPrime,\n Env = EnvPrime\n else\n compile_error($file, $pred, Context,\n \"Two or more parameters have the same name\")\n ),\n Info = ast_pre_info(Arity),\n ast_to_pre(Info, Env, Body0, Body, UseVars, !Varmap).\n\n%-----------------------------------------------------------------------%\n\n:- pred ast_to_pre(ast_pre_info::in, env::in, list(ast_block_thing)::in,\n pre_statements::out, set(var)::out, varmap::in, varmap::out) is det.\n\nast_to_pre(Info, Env, Block0, Block, UseVars, !Varmap) :-\n ast_to_pre_block(Info, Block0, Block, UseVars, _, Env, _, !Varmap).\n\n%-----------------------------------------------------------------------%\n\n:- pred ast_to_pre_block(ast_pre_info::in, list(ast_block_thing)::in,\n list(pre_statement)::out, set(var)::out,\n set(var)::out, env::in, env::out, varmap::in, varmap::out) is det.\n\nast_to_pre_block(Info, Block0, Block, union_list(UseVars),\n union_list(DefVars), !Env, !Varmap) :-\n ast_to_pre_block_2(Info, Block0, StmtsList, UseVars, DefVars, !Env,\n !Varmap),\n Block = condense(StmtsList).\n\n% It seems silly to use both Env and !Varmap. They are used differently by\n% branches, with varmap tracking all variables and Env being rewound to the\n% state before the branch. Secondly Env will also capture symbols that\n% aren't variables, such as modules and instances.\n\n:- pred ast_to_pre_block_2(ast_pre_info::in, list(ast_block_thing)::in,\n list(list(pre_statement))::out, list(set(var))::out, list(set(var))::out,\n env::in, env::out, varmap::in, varmap::out) is det.\n\nast_to_pre_block_2(_, [], [], [], [], !Env, !Varmap).\nast_to_pre_block_2(Info, [BlockThing | Block0], [Stmts0 | Stmts],\n [UseVarsHead | UseVarsTail], [DefVarsHead | DefVarsTail],\n !Env, !Varmap) :-\n ( BlockThing = astbt_statement(Stmt),\n ast_to_pre_stmt(Info, Stmt, Stmts0, UseVarsHead, DefVarsHead,\n !Env, !Varmap),\n Block = Block0\n ; BlockThing = astbt_function(_, _),\n take_while(pred(astbt_function(_, _)::in) is semidet,\n [BlockThing | Block0], Defns, Block),\n ast_to_pre_block_defns(Defns, Stmts0, UseVarsHead, DefVarsHead,\n !Env, !Varmap)\n\n ),\n ast_to_pre_block_2(Info, Block, Stmts, UseVarsTail, DefVarsTail,\n !Env, !Varmap).\n\n:- pred ast_to_pre_block_defns(list(ast_block_thing)::in,\n list(pre_statement)::out, set(var)::out, set(var)::out,\n env::in, env::out, varmap::in, varmap::out) is det.\n\nast_to_pre_block_defns(Defns0, Stmts, UseVars, DefVars, !Env, !Varmap) :-\n Defns = map((func(BT) = {N, F} :-\n ( BT = astbt_function(N, F)\n ; BT = astbt_statement(_),\n unexpected($file, $pred, \"Statement\")\n )\n ), Defns0),\n\n % 1. Pre-process definitions into a letrec so that mutual recursion is\n % supported.\n map_foldl2(defn_make_letrec, Defns, Vars, !Env, !Varmap),\n\n % 2. Create the bodies.\n env_enter_closure(!.Env, EnvInClosure),\n map2_foldl2(defn_make_pre_body, Defns, Exprs, UseVarsList,\n EnvInClosure, _, !Varmap),\n env_leave_letrec(!Env),\n\n % 3. Create the expressions and statements.\n map4_corresponding2(defn_make_stmt, Defns, Vars, Exprs, UseVarsList,\n StmtsList, DefVarsList),\n Stmts = condense(StmtsList),\n UseVars = union_list(UseVarsList),\n DefVars = union_list(DefVarsList).\n\n:- pred defn_make_letrec({nq_name, ast_nested_function}::in, var::out,\n env::in, env::out, varmap::in, varmap::out) is det.\n\ndefn_make_letrec({Name, ast_nested_function(Decl, _)}, Var, !Env, !Varmap) :-\n Context = Decl ^ afd_context,\n NameStr = nq_name_to_string(Name),\n ( if env_add_for_letrec(NameStr, VarPrime, !Env, !Varmap) then\n Var = VarPrime\n else\n compile_error($file, $pred, Context,\n format(\"Name already defined for nested function: %s\",\n [s(NameStr)]))\n ).\n\n:- pred defn_make_pre_body({nq_name, ast_nested_function}::in, pre_expr::out,\n set(var)::out, env::in, env::out, varmap::in, varmap::out) is det.\n\ndefn_make_pre_body({Name, ast_nested_function(Decl, Body0)}, Expr, UseVars,\n !Env, !Varmap) :-\n Decl = ast_function_decl(Params0, Returns, _, Context),\n NameStr = nq_name_to_string(Name),\n MangledName = mangle_lambda(NameStr, Context),\n env_lookup_lambda(!.Env, MangledName, FuncId),\n env_letrec_self_recursive(NameStr, FuncId, !.Env, EnvSelfRec),\n Arity = arity(length(Returns)),\n ast_to_pre_body(EnvSelfRec, Context, Arity, Params0, Params, Body0, Body,\n UseVars, !Varmap),\n % Until we properly implement letrecs we mark each variable as defined\n % immediately after its definition. We'll need this to properly support\n % optimisation of mutually-recursive closures.\n env_letrec_defined(NameStr, !Env),\n Expr = e_lambda(pre_lambda(FuncId, Params, no, Arity, Body)).\n\n:- pred defn_make_stmt({nq_name, ast_nested_function}::in, var::in,\n pre_expr::in, set(var)::in, pre_statements::out, set(var)::out) is det.\n\ndefn_make_stmt({_, ast_nested_function(Decl, _)},\n Var, Expr, UseVars, Stmts, DefVars) :-\n Context = Decl ^ afd_context,\n DefVars = make_singleton_set(Var),\n Stmts = [\n pre_statement(s_decl_vars([Var]),\n stmt_info(Context, set.init, set.init, stmt_always_fallsthrough)),\n pre_statement(s_assign([var(Var)], [Expr]),\n stmt_info(Context, UseVars, DefVars, stmt_always_fallsthrough))\n ].\n\n%-----------------------------------------------------------------------%\n\n % Info for the current function during the ast-to-pre transformation.\n %\n:- type ast_pre_info\n ---> ast_pre_info(\n % The arity of the function.\n api_arity :: arity\n ).\n\n:- pred ast_to_pre_stmt(ast_pre_info::in, ast_statement::in,\n pre_statements::out, set(var)::out, set(var)::out,\n env::in, env::out, varmap::in, varmap::out) is det.\n\nast_to_pre_stmt(Info, ast_statement(StmtType0, Context), Stmts,\n UseVars, DefVars, !Env, !Varmap) :-\n ( StmtType0 = s_call(Call),\n ast_to_pre_stmt_call(!.Env, Context, Call, Stmts, UseVars, DefVars,\n !Varmap)\n ; StmtType0 = s_assign_statement(Patterns, Exprs),\n ast_to_pre_stmt_assign(Context, Patterns, Exprs, Stmts,\n UseVars, DefVars, !Env, !Varmap)\n ; StmtType0 = s_array_set_statement(_, _, _),\n my_exception.sorry($file, $pred, Context, \"Arrays\")\n ; StmtType0 = s_return_statement(Exprs),\n ast_to_pre_stmt_return(Info, !.Env, Context, Exprs, Stmts, UseVars,\n DefVars, !Varmap)\n ; StmtType0 = s_var_statement(VarName),\n ast_to_pre_stmt_var(Context, VarName, Stmts, UseVars, DefVars,\n !Env, !Varmap)\n ; StmtType0 = s_match_statement(Expr, Cases),\n ast_to_pre_stmt_match(Info, Context, Expr, Cases, Stmts, UseVars,\n DefVars, !Env, !Varmap)\n ; StmtType0 = s_ite(Cond, Then, Else),\n ast_to_pre_stmt_ite(Info, Context, Cond, Then, Else, Stmts, UseVars,\n DefVars, !Env, !Varmap)\n ).\n\n:- pred ast_to_pre_stmt_call(env::in, context::in, ast_call_like::in,\n pre_statements::out, set(var)::out, set(var)::out,\n varmap::in, varmap::out) is det.\n\nast_to_pre_stmt_call(Env, Context, Call0, Stmts, UseVars, DefVars, !Varmap) :-\n ast_to_pre_call_like(Context, Env, Call0, CallLike, UseVars, !Varmap),\n ( CallLike = pcl_call(Call)\n ; CallLike = pcl_constr(_),\n compile_error($file, $pred,\n \"A construction is not a statement\")\n ),\n DefVars = set.init,\n StmtType = s_call(Call),\n Stmts = [pre_statement(StmtType,\n stmt_info(Context, UseVars, DefVars, stmt_always_fallsthrough))].\n\n:- pred ast_to_pre_stmt_assign(context::in, list(ast_pattern)::in,\n list(ast_expression)::in, pre_statements::out, set(var)::out, set(var)::out,\n env::in, env::out, varmap::in, varmap::out) is det.\n\nast_to_pre_stmt_assign(Context, Patterns, Exprs0, Stmts, UseVars, DefVars,\n !Env, !Varmap) :-\n % Process the expressions before adding the variables, this may\n % create confusing errors (without column numbers) but at least\n % it'll be correct.\n map2_foldl(ast_to_pre_expr(Context, !.Env), Exprs0, Exprs,\n ExprsUseVarss, !Varmap),\n ExprsUseVars = union_list(ExprsUseVarss),\n\n ( if\n map_foldl3(pattern_simple_vars_or_wildcards(Context),\n Patterns, VarOrWildcards, [], DeclVars, !Env, !Varmap)\n then\n filter_map(vow_is_var, VarOrWildcards, Vars),\n DefVars = list_to_set(Vars),\n UseVars = ExprsUseVars,\n Stmts = [\n pre_statement(s_decl_vars(DeclVars),\n stmt_info(Context, init, init, stmt_always_fallsthrough)),\n pre_statement(s_assign(VarOrWildcards, Exprs),\n stmt_info(Context, UseVars, DefVars,\n stmt_always_fallsthrough))]\n else if\n Patterns = [Pattern],\n Exprs = [Expr]\n then\n ast_to_pre_stmt_unpack(Context, Pattern, Expr, Stmts,\n UsedVars0, DefVars, !Env, !Varmap),\n UseVars = ExprsUseVars `union` UsedVars0\n else\n my_exception.sorry($file, $pred, Context,\n \"Can't unpack more than one pattern\")\n ).\n\n:- pred pattern_simple_vars_or_wildcards(context::in, ast_pattern::in,\n var_or_wildcard(var)::out, list(var)::in, list(var)::out,\n env::in, env::out, varmap::in, varmap::out)\n is semidet.\n\npattern_simple_vars_or_wildcards(Context, p_var(Name), VOW,\n !DeclVars, !Env, !Varmap) :-\n ( if env_add_and_initlalise_var(Name, Var, !Env, !Varmap) then\n VOW = var(Var),\n !:DeclVars = [Var | !.DeclVars]\n else\n compile_error($file, $pred, Context,\n format(\"The variable '%s' is already declared\", [s(Name)]))\n ).\npattern_simple_vars_or_wildcards(Context, p_symbol(Symbol), VOW,\n !DeclVars, !Env, !Varmap) :-\n q_name_is_single(Symbol, Name),\n env_initialise_var(Name, Result, !Env, !Varmap),\n require_complete_switch [Result]\n ( Result = ok(Var),\n VOW = var(Var)\n ; Result = does_not_exist,\n false\n ; Result = already_initialised,\n compile_error($file, $pred, Context,\n format(\"The variable '%s' is already initialised\", [s(Name)]))\n ; Result = inaccessible,\n compile_error($file, $pred, Context,\n format(\"The variable '%s' is defined in an outer scope and \" ++\n \"cannot be initialised from within this closure\",\n [s(Name)]))\n ).\npattern_simple_vars_or_wildcards(_, p_wildcard, wildcard,\n !DeclVars, !Env, !Varmap).\n\n:- pred ast_to_pre_stmt_return(ast_pre_info::in, env::in, context::in,\n list(ast_expression)::in, pre_statements::out,\n set(var)::out, set(var)::out, varmap::in, varmap::out) is det.\n\nast_to_pre_stmt_return(Info, Env, Context, Exprs0, Stmts, UseVars,\n DefVars, !Varmap) :-\n map2_foldl(ast_to_pre_expr(Context, Env), Exprs0, Exprs, ExprsUseVars,\n !Varmap),\n UseVars = union_list(ExprsUseVars),\n Arity = Info ^ api_arity,\n varmap.add_n_anon_vars(Arity ^ a_num, Vars, !Varmap),\n RetVars = list_to_set(Vars),\n DefVars = RetVars,\n Stmts = [\n pre_statement(s_decl_vars(Vars),\n stmt_info(Context, set.init, set.init, stmt_always_fallsthrough)),\n pre_statement(s_assign(map(func(V) = var(V), Vars), Exprs),\n stmt_info(Context, UseVars, DefVars, stmt_always_fallsthrough)),\n pre_statement(s_return(Vars),\n stmt_info(Context, RetVars, set.init, stmt_always_returns))\n ].\n\n:- pred ast_to_pre_stmt_var(context::in, string::in, pre_statements::out,\n set(var)::out, set(var)::out, env::in, env::out, varmap::in, varmap::out)\n is det.\n\nast_to_pre_stmt_var(Context, VarName, Stmts, UseVars, DefVars,\n !Env, !Varmap) :-\n ( if env_add_uninitialised_var(VarName, Var, !Env, !Varmap) then\n UseVars = init,\n DefVars = init,\n Stmts = [pre_statement(s_decl_vars([Var]),\n stmt_info(Context, set.init, set.init,\n stmt_always_fallsthrough))]\n else\n compile_error($file, $pred, Context,\n format(\"The variable '%s' is already defined\", [s(VarName)]))\n ).\n\n:- pred ast_to_pre_stmt_match(ast_pre_info::in, context::in, ast_expression::in,\n list(ast_match_case)::in, pre_statements::out, set(var)::out, set(var)::out,\n env::in, env::out, varmap::in, varmap::out) is det.\n\nast_to_pre_stmt_match(Info, Context, Expr0, Cases0, Stmts, UseVars, DefVars,\n !Env, !Varmap) :-\n ast_to_pre_expr(Context, !.Env, Expr0, Expr, UseVarsExpr, !Varmap),\n varmap.add_anon_var(Var, !Varmap),\n StmtsAssign = [\n pre_statement(s_decl_vars([Var]),\n stmt_info(Context, set.init, set.init,\n stmt_always_fallsthrough)),\n pre_statement(s_assign([var(Var)], [Expr]),\n stmt_info(Context, UseVarsExpr, make_singleton_set(Var),\n stmt_always_fallsthrough))\n ],\n\n map3_foldl(ast_to_pre_case(Info, Context, !.Env), Cases0, Cases,\n UseVarsCases, DefVars0, !Varmap),\n\n UseVars = union_list(UseVarsCases) `union` make_singleton_set(Var),\n DefVars = union_list(DefVars0) `intersect`\n env_uninitialised_vars(!.Env),\n env_mark_initialised(DefVars, !Env),\n % The reachability information will be updated later in\n % pre.branches\n StmtMatch = pre_statement(s_match(Var, Cases),\n stmt_info(Context, UseVars, DefVars, stmt_may_return)),\n\n Stmts = StmtsAssign ++ [StmtMatch].\n\n:- pred ast_to_pre_stmt_unpack(context::in, ast_pattern::in,\n pre_expr::in, pre_statements::out, set(var)::out,\n set(var)::out, env::in, env::out, varmap::in, varmap::out) is det.\n\nast_to_pre_stmt_unpack(Context, Pattern0, Expr, Stmts, UsedVars, DefVars,\n !Env, !Varmap) :-\n % Transform the pattern then rename all the variables in the pattern to\n % new fresh variables.\n ast_to_pre_pattern(Context, Pattern0, Pattern1, PatVarsSet, !Env, !Varmap),\n pat_rename(PatVarsSet, Pattern1, Pattern, map.init, Renaming, !Varmap),\n\n PatternVarPairs = to_assoc_list(Renaming),\n\n % The list of variables form the original pattern.\n PatternVars = map(fst, PatternVarPairs),\n % The list of new variables, they have the same positions in their list\n % as the original set.\n PrimeVars = map(snd, PatternVarPairs),\n PrimeVarsSet = list_to_set(PrimeVars),\n\n % The new pattern with the renamed variables is used with an expression\n % to copy those variables out. TODO: For now we can only handle\n % patterns that extract a single variable.\n ( PrimeVars = [],\n unexpected($file, $pred, \"Zero variables bound by unpack\")\n ; PrimeVars = [_ | _],\n CopyVarsOutExprs = map(func(V) = e_var(V), PrimeVars)\n ),\n MatchExpr = e_match(Expr, [pre_e_case(Pattern, CopyVarsOutExprs)]),\n\n % The assignment must assign variables in the same order that\n % CopyVarsOutExpr returns them as.\n DefVars = list_to_set(PatternVars),\n PatternVarsVars = map(func(V) = var(V), PatternVars),\n AssignStmt = pre_statement(s_assign(PatternVarsVars, [MatchExpr]),\n stmt_info(Context, UsedVars, DefVars, stmt_always_fallsthrough)),\n\n Stmts = [\n pre_statement(s_decl_vars(PatternVars),\n stmt_info(Context, set.init, set.init, stmt_always_fallsthrough)),\n AssignStmt],\n UsedVars = PatVarsSet `union` PrimeVarsSet.\n\n:- pred ast_to_pre_stmt_ite(ast_pre_info::in, context::in, ast_expression::in,\n list(ast_block_thing)::in, list(ast_block_thing)::in,\n pre_statements::out, set(var)::out, set(var)::out,\n env::in, env::out, varmap::in, varmap::out) is det.\n\nast_to_pre_stmt_ite(Info, Context, Cond0, Then0, Else0, Stmts, UseVars, DefVars,\n !Env, !Varmap) :-\n % ITEs are syntas sugar for a match expression using booleans.\n\n ast_to_pre_expr(Context, !.Env, Cond0, Cond, UseVarsCond, !Varmap),\n varmap.add_anon_var(Var, !Varmap),\n % TODO: To avoid amberguities, we may need a way to force this\n % variable to be bool at this point in the compiler when we know that\n % it's a bool.\n StmtsAssign = [\n pre_statement(s_decl_vars([Var]),\n stmt_info(Context, set.init, set.init,\n stmt_always_fallsthrough)),\n pre_statement(s_assign([var(Var)], [Cond]),\n stmt_info(Context, UseVarsCond, make_singleton_set(Var),\n stmt_always_fallsthrough))\n ],\n\n ast_to_pre_block(Info, Then0, Then, UseVarsThen, DefVarsThen, !.Env, _,\n !Varmap),\n Operators = env_operators(!.Env),\n TrueId = Operators ^ o_bool_true,\n TrueCase = pre_case(p_constr(make_singleton_set(TrueId), []), Then),\n ast_to_pre_block(Info, Else0, Else, UseVarsElse, DefVarsElse, !.Env, _,\n !Varmap),\n FalseId = Operators ^ o_bool_false,\n FalseCase = pre_case(p_constr(make_singleton_set(FalseId), []), Else),\n\n UseVars = UseVarsCond `union` UseVarsThen `union` UseVarsElse `union`\n make_singleton_set(Var),\n DefVars = union(DefVarsThen, DefVarsElse) `intersect`\n env_uninitialised_vars(!.Env),\n env_mark_initialised(DefVars, !Env),\n StmtMatch = pre_statement(s_match(Var, [TrueCase, FalseCase]),\n stmt_info(Context, UseVars, DefVars, stmt_may_return)),\n Stmts = StmtsAssign ++ [StmtMatch].\n\n%-----------------------------------------------------------------------%\n\n:- pred ast_to_pre_case(ast_pre_info::in, context::in, env::in,\n ast_match_case::in, pre_case::out, set(var)::out, set(var)::out,\n varmap::in, varmap::out) is det.\n\nast_to_pre_case(Info, Context, !.Env, ast_match_case(Pattern0, Stmts0),\n pre_case(Pattern, Stmts), UseVars, DefVars, !Varmap) :-\n ast_to_pre_pattern(Context, Pattern0, Pattern, DefVarsPattern, !Env,\n !Varmap),\n ast_to_pre_block(Info, Stmts0, Stmts, UseVars, DefVarsStmts, !Env,\n !Varmap),\n DefVars = DefVarsPattern `union` DefVarsStmts,\n _ = !.Env.\n\n:- pred ast_to_pre_pattern(context::in, ast_pattern::in, pre_pattern::out,\n set(var)::out, env::in, env::out, varmap::in, varmap::out) is det.\n\nast_to_pre_pattern(_, p_number(Num), p_number(Num), set.init, !Env, !Varmap).\nast_to_pre_pattern(Context, p_constr(Name, Args0), Pattern, Vars, !Env,\n !Varmap) :-\n ( if env_search_constructor(!.Env, Name, CtorIds) then\n map2_foldl2(ast_to_pre_pattern(Context), Args0, Args, ArgsVars,\n !Env, !Varmap),\n Vars = union_list(ArgsVars),\n Pattern = p_constr(CtorIds, Args)\n else\n ( if\n Args0 = [],\n q_name_is_single(Name, _)\n then\n Kind = \"variable or constructor\"\n else\n Kind = \"constructor\"\n ),\n compile_error($file, $pred, Context,\n format(\"Unknown %s '%s'\", [s(Kind), s(q_name_to_string(Name))]))\n ).\nast_to_pre_pattern(_, p_list_nil, Pattern, set.init, !Env, !Varmap) :-\n Pattern = p_constr(\n make_singleton_set(env_operators(!.Env) ^ o_list_nil),\n []).\nast_to_pre_pattern(Context, p_list_cons(Head0, Tail0), Pattern, Vars,\n !Env, !Varmap) :-\n ast_to_pre_pattern(Context, Head0, Head, HeadVars, !Env, !Varmap),\n ast_to_pre_pattern(Context, Tail0, Tail, TailVars, !Env, !Varmap),\n Vars = HeadVars `union` TailVars,\n Pattern = p_constr(make_singleton_set(env_operators(!.Env) ^ o_list_cons),\n [Head, Tail]).\nast_to_pre_pattern(_, p_wildcard, p_wildcard, set.init, !Env, !Varmap).\nast_to_pre_pattern(Context, p_var(Name), Pattern, DefVars, !Env, !Varmap) :-\n ( if env_add_and_initlalise_var(Name, Var, !Env, !Varmap) then\n Pattern = p_var(Var),\n DefVars = make_singleton_set(Var)\n else\n compile_error($file, $pred, Context,\n format(\"Variable '%s' already defined\", [s(Name)]))\n ).\nast_to_pre_pattern(Context, p_symbol(Symbol), Pattern, DefVars,\n !Env, !Varmap) :-\n ( if q_name_is_single(Symbol, Name) then\n env_initialise_var(Name, Result, !Env, !Varmap),\n ( Result = ok(Var),\n Pattern = p_var(Var),\n DefVars = make_singleton_set(Var)\n ; Result = does_not_exist,\n ast_to_pre_pattern(Context, p_constr(Symbol, []), Pattern, DefVars,\n !Env, !Varmap)\n ; Result = already_initialised,\n compile_error($file, $pred, Context, \"Variable already initialised\")\n ; Result = inaccessible,\n unexpected($file, $pred, \"Inaccessible?\")\n )\n else\n ast_to_pre_pattern(Context, p_constr(Symbol, []), Pattern, DefVars,\n !Env, !Varmap)\n ).\n\n:- pred ast_to_pre_expr(context::in, env::in, ast_expression::in,\n pre_expr::out, set(var)::out, varmap::in, varmap::out) is det.\n\nast_to_pre_expr(Context, Env, Expr0, Expr, Vars, !Varmap) :-\n ast_to_pre_expr_2(Context, Env, Expr0, Expr1, Vars, !Varmap),\n ( if Expr1 = e_constant(c_ctor(ConsIds)) then\n Expr = e_construction(ConsIds, [])\n else\n Expr = Expr1\n ).\n\n:- pred ast_to_pre_expr_2(context::in, env::in,\n ast_expression::in, pre_expr::out, set(var)::out,\n varmap::in, varmap::out) is det.\n\nast_to_pre_expr_2(Context, Env, e_call_like(Call0), Expr, Vars, !Varmap) :-\n ast_to_pre_call_like(Context, Env, Call0, CallLike, Vars, !Varmap),\n ( CallLike = pcl_call(Call),\n Expr = e_call(Call)\n ; CallLike = pcl_constr(Expr)\n ).\nast_to_pre_expr_2(Context, Env, e_u_op(Op, SubExpr0), Expr, Vars, !Varmap) :-\n ast_to_pre_expr(Context, Env, SubExpr0, SubExpr, Vars, !Varmap),\n Expr = e_call(pre_call(env_unary_operator_func(Env, Op), [SubExpr],\n without_bang)).\nast_to_pre_expr_2(Context, Env, e_b_op(ExprL0, Op, ExprR0), Expr, Vars,\n !Varmap) :-\n ast_to_pre_expr(Context, Env, ExprL0, ExprL, VarsL, !Varmap),\n ast_to_pre_expr(Context, Env, ExprR0, ExprR, VarsR, !Varmap),\n Vars = union(VarsL, VarsR),\n % NOTE: When introducing interfaces for primative types this will need\n % to change\n env_operator_entry(Env, Op, OpEntry),\n ( OpEntry = ee_func(OpFunc),\n Expr = e_call(pre_call(OpFunc, [ExprL, ExprR], without_bang))\n ; OpEntry = ee_constructor(OpCtors),\n Expr = e_construction(OpCtors, [ExprL, ExprR])\n ).\nast_to_pre_expr_2(Context, Env, e_match(MatchExpr0, Cases0), Expr, Vars,\n !Varmap) :-\n ast_to_pre_expr(Context, Env, MatchExpr0, MatchExpr, MatchVars, !Varmap),\n map2_foldl(ast_to_pre_expr_case(Context, Env), Cases0, Cases, CasesVars,\n !Varmap),\n Expr = e_match(MatchExpr, Cases),\n Vars = MatchVars `union` union_list(CasesVars).\nast_to_pre_expr_2(Context, Env, e_if(Cond0, Then0, Else0), Expr, Vars,\n !Varmap) :-\n ast_to_pre_expr(Context, Env, Cond0, Cond, CondVars, !Varmap),\n map2_foldl(ast_to_pre_expr(Context, Env), Then0, Then, ThenVars, !Varmap),\n map2_foldl(ast_to_pre_expr(Context, Env), Else0, Else, ElseVars, !Varmap),\n Operators = env_operators(Env),\n PatTrue = p_constr(make_singleton_set(Operators ^ o_bool_true), []),\n PatFalse = p_constr(make_singleton_set(Operators ^ o_bool_false), []),\n Expr = e_match(Cond,\n [pre_e_case(PatTrue, Then),\n pre_e_case(PatFalse, Else)]),\n Vars = CondVars `union` union_list(ThenVars) `union` union_list(ElseVars).\nast_to_pre_expr_2(Context, Env, e_symbol(Symbol), Expr, Vars, !Varmap) :-\n env_search(Env, Symbol, Result),\n ( Result = ok(Entry),\n ( Entry = ee_var(Var),\n Expr = e_var(Var),\n Vars = make_singleton_set(Var)\n ; Entry = ee_constructor(Constrs),\n Expr = e_constant(c_ctor(Constrs)),\n Vars = set.init\n ; Entry = ee_func(Func),\n Expr = e_constant(c_func(Func)),\n Vars = set.init\n )\n ; Result = not_found,\n compile_error($file, $pred, Context,\n format(\"Unknown symbol: %s\", [s(q_name_to_string(Symbol))]))\n ;\n ( Result = not_initaliased\n % Varibles may be inaccessible because they're not initalised.\n ; Result = inaccessible\n ),\n compile_error($file, $pred, Context,\n format(\"Variable not initalised: %s\",\n [s(q_name_to_string(Symbol))]))\n ; Result = maybe_cyclic_retlec,\n my_exception.sorry($file, $pred, Context,\n format(\"%s is possibly involved in a mutual recursion of \" ++\n \"closures. If they're not mutually recursive try \" ++\n \"re-ordering them.\",\n [s(q_name_to_string(Symbol))]))\n ).\nast_to_pre_expr_2(_, Env, e_const(Const0), e_constant((Const)), init,\n !Varmap) :-\n ( Const0 = c_string(String),\n Const = c_string(String)\n ; Const0 = c_number(Number),\n Const = c_number(Number)\n ; Const0 = c_list_nil,\n Const = c_ctor(make_singleton_set(env_operators(Env) ^ o_list_nil))\n ).\nast_to_pre_expr_2(Context, _, e_array(_), _, _, !Varmap) :-\n my_exception.sorry($file, $pred, Context, \"Arrays\").\n\n:- type pre_call_like\n ---> pcl_call(pre_call)\n ; pcl_constr(pre_expr).\n\n:- pred ast_to_pre_call_like(context::in, env::in,\n ast_call_like::in, pre_call_like::out, set(var)::out,\n varmap::in, varmap::out) is det.\n\nast_to_pre_call_like(Context, Env, CallLike0, CallLike, Vars, !Varmap) :-\n ( CallLike0 = ast_call_like(CalleeExpr0, Args0),\n WithBang = without_bang\n ; CallLike0 = ast_bang_call(CalleeExpr0, Args0),\n WithBang = with_bang\n ),\n % For the callee we call the _2 version, which does not convert\n % constructors with no args into constructions.\n ast_to_pre_expr_2(Context, Env, CalleeExpr0, CalleeExpr, CalleeVars,\n !Varmap),\n map2_foldl(ast_to_pre_expr(Context, Env), Args0, Args, Varss, !Varmap),\n Vars = union_list(Varss) `union` CalleeVars,\n ( if CalleeExpr = e_constant(c_func(Callee)) then\n CallLike = pcl_call(pre_call(Callee, Args, WithBang))\n else if CalleeExpr = e_constant(c_ctor(CtorIds)) then\n ( WithBang = with_bang,\n compile_error($file, $pred,\n \"Construction must not have bang\")\n ; WithBang = without_bang,\n CallLike = pcl_constr(e_construction(CtorIds, Args))\n )\n else\n CallLike = pcl_call(pre_ho_call(CalleeExpr, Args, WithBang))\n ).\n\n:- pred ast_to_pre_expr_case(context::in, env::in, ast_expr_match_case::in,\n pre_expr_case::out, set(var)::out, varmap::in, varmap::out) is det.\n\nast_to_pre_expr_case(Context, Env0,\n ast_emc(Pat0, Exprs0), pre_e_case(Pat, Exprs), Vars, !Varmap) :-\n % Pretty sure we don't need to capture the new variable here as we do in\n % the match statements.\n ast_to_pre_pattern(Context, Pat0, Pat, _, Env0, Env, !Varmap),\n map2_foldl(ast_to_pre_expr(Context, Env), Exprs0, Exprs, Varss, !Varmap),\n Vars = union_list(Varss).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.import.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pre.import.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Process imports by reading interface files.\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module list.\n:- import_module maybe.\n\n:- import_module ast.\n:- import_module compile_error.\n:- import_module core.\n:- import_module pre.env.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.log.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- type import_type\n ---> interface_import\n ; typeres_import.\n\n%-----------------------------------------------------------------------%\n\n:- type import_info\n ---> import_info(\n ii_module :: q_name,\n ii_whitelisted :: whitelisted,\n ii_source_file :: maybe(string),\n ii_interface_file :: string,\n ii_interface_exists :: file_exists,\n ii_typeres_file :: string,\n ii_typeres_exists :: file_exists\n ).\n\n:- type whitelisted\n ---> w_is_whitelisted\n ; w_not_whitelisted\n ; w_no_whitelist.\n\n:- type file_exists\n ---> file_exists\n ; file_does_not_exist.\n\n%-----------------------------------------------------------------------%\n\n % ast_to_import_list(ThisModule, Directory, WhitelistFile,\n % Imports, ImportInfo, !IO)\n %\n % Find the list of modules and their files we need to import.\n %\n:- pred ast_to_import_list(q_name::in, string::in, maybe(string)::in,\n list(ast_import)::in, list(import_info)::out, io::di, io::uo) is det.\n\n % ast_to_core_imports(Verbose, ModuleName, ImportType, ImportEnv,\n % MaybeWhitelistFile, Imports, !Env, !Core, !Errors, !IO).\n %\n % The ImportEnv is the Env that should be used to read interface files,\n % while !Env is a different environment to be updated with the results.\n %\n:- pred ast_to_core_imports(log_config::in, q_name::in, import_type::in,\n env::in, maybe(string)::in, list(ast_import)::in,\n env::in, env::out, core::in, core::out,\n errors(compile_error)::in, errors(compile_error)::out, io::di, io::uo)\n is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module assoc_list.\n:- import_module cord.\n:- import_module map.\n:- import_module pair.\n:- import_module require.\n:- import_module set.\n:- import_module string.\n:- import_module unit.\n\n:- import_module common_types.\n:- import_module constant.\n:- import_module context.\n:- import_module core.function.\n:- import_module core.resource.\n:- import_module core.types.\n:- import_module file_utils.\n:- import_module parse.\n:- import_module parse_util.\n:- import_module pre.ast_to_core.\n:- import_module util.my_exception.\n:- import_module util.my_io.\n:- import_module util.mercury.\n:- import_module util.path.\n\n%-----------------------------------------------------------------------%\n\nast_to_import_list(ThisModule, Dir, MaybeWhitelistFile, Imports, Result, !IO) :-\n ( MaybeWhitelistFile = yes(WhitelistFile),\n read_whitelist(ThisModule, WhitelistFile, MaybeWhitelist, !IO)\n ; MaybeWhitelistFile = no,\n MaybeWhitelist = no\n ),\n\n ModuleNames = sort_and_remove_dups(map(func(I) = I ^ ai_name, Imports)),\n map_foldl2(make_import_info(Dir, MaybeWhitelist), ModuleNames, Result,\n init, _, !IO).\n\n:- pred make_import_info(string::in, maybe(import_whitelist)::in, q_name::in,\n import_info::out, dir_info::in, dir_info::out, io::di, io::uo) is det.\n\nmake_import_info(Path, MaybeWhitelist, Module, Result, !DirInfo, !IO) :-\n ( MaybeWhitelist = no,\n Whitelisted = w_no_whitelist\n ; MaybeWhitelist = yes(Whitelist),\n ( if member(Module, Whitelist) then\n Whitelisted = w_is_whitelisted\n else\n Whitelisted = w_not_whitelisted\n )\n ),\n\n find_module_file(Path, source_extension, Module, ResultSource,\n !DirInfo, !IO),\n\n ( ResultSource = yes(SourceFile),\n MbSourceFile = yes(SourceFile)\n ; ResultSource = no,\n MbSourceFile = no\n ; ResultSource = error(ErrPath, Error),\n compile_error($file, $pred,\n \"IO error while searching for modules: \" ++\n ErrPath ++ \": \" ++ Error)\n ),\n\n find_module_file(Path, interface_extension, Module, ResultInterface,\n !DirInfo, !IO),\n CanonBaseName = canonical_base_name(Module),\n ( ResultInterface = yes(InterfaceFile),\n InterfaceExists = file_exists\n ; ResultInterface = no,\n InterfaceFile = CanonBaseName ++ interface_extension,\n InterfaceExists = file_does_not_exist\n ; ResultInterface = error(ErrPath, Error),\n compile_error($file, $pred,\n \"IO error while searching for modules: \" ++\n ErrPath ++ \": \" ++ Error)\n ),\n\n find_module_file(Path, typeres_extension, Module, ResultTypeRes,\n !DirInfo, !IO),\n ( ResultTypeRes = yes(TyperesFile),\n TyperesExists = file_exists\n ; ResultTypeRes = no,\n TyperesFile = CanonBaseName ++ typeres_extension,\n TyperesExists = file_does_not_exist\n ; ResultTypeRes = error(ErrPath, Error),\n compile_error($file, $pred,\n \"IO error while searching for modules: \" ++\n ErrPath ++ \": \" ++ Error)\n ),\n\n Result = import_info(Module, Whitelisted, MbSourceFile,\n InterfaceFile, InterfaceExists, TyperesFile, TyperesExists).\n\n%-----------------------------------------------------------------------%\n\n:- type import_whitelist == set(q_name).\n\n:- pred read_whitelist(q_name::in, string::in, maybe(import_whitelist)::out,\n io::di, io::uo) is det.\n\nread_whitelist(ThisModule, Filename, MaybeWhitelist, !IO) :-\n io.open_input(Filename, OpenRes, !IO),\n ( OpenRes = ok(File),\n read(File, WhitelistRes, !IO),\n ( WhitelistRes = ok(WhitelistList `with_type` list(list(q_name))),\n % The whitelist is stored as the list of lists of modules groups\n % from the build file, we need to find the relevant sets and\n % compute their intersection.\n ModulesSets = filter(\n pred(M::in) is semidet :- member(ThisModule, M),\n map(set.from_list, WhitelistList)),\n ( ModulesSets = [],\n % We can't compute the intersection of zero sets, so ignore\n % the whitelist. This can happen if the module name in the\n % build file doesn't match the actual name.\n MaybeWhitelist = no\n ; ModulesSets = [_ | _],\n MaybeWhitelist = yes(delete(power_intersect_list(ModulesSets),\n ThisModule))\n )\n ; WhitelistRes = eof,\n compile_error($file, $pred, format(\"%s: premature end of file\",\n [s(Filename)]))\n ; WhitelistRes = error(Error, Line),\n compile_error($file, $pred, format(\"%s:%d: %s\",\n [s(Filename), i(Line), s(Error)]))\n ),\n close_input(File, !IO)\n ; OpenRes = error(Error),\n compile_error($file, $pred, format(\"%s: %s\",\n [s(Filename), s(error_message(Error))]))\n ).\n\n%-----------------------------------------------------------------------%\n\nast_to_core_imports(Verbose, ThisModule, ImportType, !.ReadEnv,\n MbImportWhitelist, Imports, !Env, !Core, !Errors, !IO) :-\n ast_to_import_list(ThisModule, \".\", MbImportWhitelist, Imports,\n ImportInfos, !IO),\n\n % Read the imports and convert it to AST.\n map_foldl(read_import(Verbose, !.Core, ImportType), ImportInfos,\n ImportAsts0, !IO),\n\n % Process the imports to add them to the core representation.\n ( ImportType = interface_import,\n % We update this environment with resources and types so that we can\n % process types and functions correctly. Then throw away that\n % environment as different bindings will be made depending on the import\n % statement used.\n import_map_foldl2(gather_declarations, ImportAsts0, ImportAsts,\n !ReadEnv, !Core),\n\n % Process transitively imported things. These things are declared\n % by .typeres files we didn't read, but must exist or we wouldn't\n % have been able to generate the .pi files we're now reading. This\n % has to be done after regular declarations so those can be checked\n % more rigidly and it's simplier to do them before processing\n % definitions below.\n import_foldl2(gather_implicit_declarations, ImportAsts,\n !ReadEnv, !Core),\n\n import_map_foldl(process_interface_import(!.ReadEnv),\n ImportAsts, ImportItems, !Core)\n ; ImportType = typeres_import,\n import_map_foldl(process_typeres_import, ImportAsts0, ImportItems,\n !Core)\n ),\n\n ImportMap = map.from_assoc_list(ImportItems),\n\n % Enrol the imports in the environment.\n foldl5(enroll_import(Verbose, ImportMap), Imports, set.init, _,\n set.init, _, !Env, !Errors, !IO).\n\n%-----------------------------------------------------------------------%\n\n:- type import_map(T) == map(q_name, import_result(T)).\n:- type import_list(T) == assoc_list(q_name, import_result(T)).\n\n:- type import_result(T)\n ---> ok(T)\n ; read_error(compile_error)\n ; compile_errors(errors(compile_error)).\n\n:- pred import_map_foldl(pred(q_name, X, import_result(Y), A, A),\n import_list(X), import_list(Y), A, A).\n:- mode import_map_foldl(pred(in, in, out, in, out) is det,\n in, out, in, out) is det.\n\nimport_map_foldl(_, [], [], !A).\nimport_map_foldl(Pred, [N - XRes | Xs], [N - YRes | Ys], !A) :-\n ( XRes = ok(X),\n Pred(N, X, YRes, !A)\n ; XRes = read_error(E),\n YRes = read_error(E)\n ; XRes = compile_errors(Es),\n YRes = compile_errors(Es)\n ),\n import_map_foldl(Pred, Xs, Ys, !A).\n\n:- pred import_map_foldl2(pred(q_name, X, import_result(Y), A, A, B, B),\n import_list(X), import_list(Y), A, A, B, B).\n:- mode import_map_foldl2(pred(in, in, out, in, out, in, out) is det,\n in, out, in, out, in, out) is det.\n\nimport_map_foldl2(_, [], [], !A, !B).\nimport_map_foldl2(Pred, [N - XRes | Xs], [N - YRes | Ys], !A, !B) :-\n ( XRes = ok(X),\n Pred(N, X, YRes, !A, !B)\n ; XRes = read_error(E),\n YRes = read_error(E)\n ; XRes = compile_errors(Es),\n YRes = compile_errors(Es)\n ),\n import_map_foldl2(Pred, Xs, Ys, !A, !B).\n\n % Only processes ok(_) entries.\n %\n:- pred import_foldl2(pred(q_name, X, A, A, B, B),\n import_list(X), A, A, B, B).\n:- mode import_foldl2(pred(in, in, in, out, in, out) is det,\n in, in, out, in, out) is det.\n\nimport_foldl2(_, [], !A, !B).\nimport_foldl2(Pred, [N - XRes | Xs], !A, !B) :-\n ( XRes = ok(X),\n Pred(N, X, !A, !B)\n ; XRes = read_error(_)\n ; XRes = compile_errors(_)\n ),\n import_foldl2(Pred, Xs, !A, !B).\n\n%-----------------------------------------------------------------------%\n\n % The AST in the ast.m file stores entries in the order they occur in\n % the file. This AST stores them by type. We should consider\n % re-writing ast.m to be like this then drop this type definition. In\n % the future we may want something that reconstructs things in file\n % order but that's solveable, and not what we need today anyway.\n %\n:- type import_ast(R, T)\n ---> import_ast(\n ia_module_name :: q_name,\n ia_context :: context,\n ia_entries :: entry_types(R, T)\n ).\n\n:- type entry_types(R, T)\n ---> et_typeres(\n ett_resources :: list(q_name),\n ett_types :: list({q_name, arity})\n )\n ; et_interface(\n eti_resources :: list({q_name, maybe(ast_resource), R}),\n eti_types :: list({q_name, ast_type(q_name), T}),\n eti_functions :: list(q_named(ast_function_decl))\n ).\n\n % Read an import and convert it to core representation, store references\n % to it in the import map.\n %\n:- pred read_import(log_config::in, core::in, import_type::in, import_info::in,\n pair(q_name, import_result(import_ast(unit, unit)))::out,\n io::di, io::uo) is det.\n\nread_import(Verbose, Core, ImportType, ImportInfo, ModuleName - Result,\n !IO) :-\n ModuleName = ImportInfo ^ ii_module,\n Whitelisted = ImportInfo ^ ii_whitelisted,\n ( Whitelisted = w_not_whitelisted,\n Result = read_error(ce_module_unavailable(ModuleName,\n module_name(Core)))\n ;\n ( Whitelisted = w_is_whitelisted\n ; Whitelisted = w_no_whitelist\n ),\n\n ( ImportType = interface_import,\n FileExists = ImportInfo ^ ii_interface_exists,\n Filename = ImportInfo ^ ii_interface_file\n ; ImportType = typeres_import,\n FileExists = ImportInfo ^ ii_typeres_exists,\n Filename = ImportInfo ^ ii_typeres_file\n ),\n ( FileExists = file_exists,\n verbose_output(Verbose,\n format(\"Reading %s from %s\\n\",\n [s(q_name_to_string(ModuleName)), s(Filename)]),\n !IO),\n\n ( ImportType = interface_import,\n parse_interface(Filename, MaybeAST, !IO),\n ( MaybeAST = ok(AST),\n foldl3(filter_entries, AST ^ a_entries, [], Resources0,\n [], Types0, [], Funcs),\n Resources = map(\n func(q_named(Name, Res)) = {Name, Res, unit},\n Resources0),\n Types = map(\n func(q_named(Name, Type)) = {Name, Type, unit},\n Types0),\n Result = ok(import_ast(AST ^ a_module_name,\n AST ^ a_context,\n et_interface(Resources, Types, Funcs)))\n ; MaybeAST = errors(Errors),\n Result = compile_errors(\n map(func(error(C, E)) =\n error(C, ce_read_source_error(E)),\n Errors))\n )\n ; ImportType = typeres_import,\n parse_typeres(Filename, MaybeAST, !IO),\n ( MaybeAST = ok(AST),\n filter_map(\n pred(asti_resource_abs(N)::in, N::out) is semidet,\n AST ^ a_entries, Resources),\n filter_map(\n pred(asti_type_abs(N, A)::in, {N, A}::out) is semidet,\n AST ^ a_entries, Types),\n Result = ok(import_ast(AST ^ a_module_name,\n AST ^ a_context, et_typeres(Resources, Types)))\n ; MaybeAST = errors(Errors),\n Result = compile_errors(\n map(func(error(C, E)) =\n error(C, ce_read_source_error(E)),\n Errors))\n )\n )\n ; FileExists = file_does_not_exist,\n Result = read_error(ce_module_not_found(ModuleName))\n )\n ).\n\n:- pred filter_entries(ast_interface_entry::in,\n list(q_named(maybe(ast_resource)))::in,\n list(q_named(maybe(ast_resource)))::out,\n list(q_named(ast_type(q_name)))::in,\n list(q_named(ast_type(q_name)))::out,\n list(q_named(ast_function_decl))::in,\n list(q_named(ast_function_decl))::out) is det.\n\nfilter_entries(asti_resource(N, R), !Resources, !Types, !Funcs) :-\n !:Resources = [q_named(N, R) | !.Resources].\nfilter_entries(asti_type(N, T), !Resources, !Types, !Funcs) :-\n !:Types = [q_named(N, T) | !.Types].\nfilter_entries(asti_function(N, F), !Resources, !Types, !Funcs) :-\n !:Funcs = [q_named(N, F) | !.Funcs].\n\n%-----------------------------------------------------------------------%\n\n:- pred process_typeres_import(q_name::in,\n import_ast(_, _)::in, import_result(import_entries)::out,\n core::in, core::out) is det.\n\nprocess_typeres_import(ModuleName, ImportAST, Result, !Core) :-\n ImportAST = import_ast(ModuleNameAST, Context, Entries),\n ( if ModuleNameAST = ModuleName then\n ( Entries = et_interface(_, _, _),\n unexpected($file, $pred, \"Interface\")\n ; Entries = et_typeres(Resources, Types),\n map_foldl((pred(Name::in, NQName - ie_resource(Res)::out,\n C0::in, C::out) is det :-\n ( if q_name_append(ModuleName, NQName0, Name) then\n NQName = NQName0\n else\n unexpected($file, $pred,\n \"Imported module exports symbols of other module\")\n ),\n core_allocate_resource_id(Res, C0, C1),\n core_set_resource(Res, r_abstract(Name), C1, C)\n ), Resources, NamePairsA, !Core),\n map_foldl((pred({Name, Arity}::in,\n NQName - ie_type(Arity, Type)::out,\n C0::in, C::out) is det :-\n ( if q_name_append(ModuleName, NQName0, Name) then\n NQName = NQName0\n else\n unexpected($file, $pred,\n \"Imported module exports symbols of other module\")\n ),\n core_allocate_type_id(Type, C0, C1),\n core_set_type(Type,\n type_init_abstract(Name, Arity, nil_context), C1, C)\n ), Types, NamePairsB, !Core),\n Result = ok(NamePairsA ++ NamePairsB)\n )\n else\n Result = compile_errors(error(Context,\n ce_interface_contains_wrong_module(\n filename(Context ^ c_file), ModuleName, ModuleNameAST)))\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred gather_declarations(q_name::in, import_ast(_, _)::in,\n import_result(import_ast(resource_id, type_id))::out, env::in, env::out,\n core::in, core::out) is det.\n\ngather_declarations(_, ImportAST0, ok(ImportAST), !Env, !Core) :-\n Entries0 = ImportAST0 ^ ia_entries,\n ( Entries0 = et_typeres(_, _),\n unexpected($file, $pred, \"Typeres\")\n ; Entries0 = et_interface(Resources0, Types0, Funcs),\n map_foldl2(gather_resource, Resources0, Resources, !Env, !Core),\n map_foldl2(gather_types, Types0, Types, !Env, !Core),\n Entries = et_interface(Resources, Types, Funcs)\n ),\n ImportAST = ImportAST0 ^ ia_entries := Entries.\n\n:- pred gather_implicit_declarations(q_name::in, import_ast(_, _)::in,\n env::in, env::out, core::in, core::out) is det.\n\ngather_implicit_declarations(ImportModule, ImportAST, !Env, !Core) :-\n ThisModule = module_name(!.Core),\n Entries = ImportAST ^ ia_entries,\n ( Entries = et_typeres(_, _),\n unexpected($file, $pred, \"Typeres\")\n ; Entries = et_interface(Resources, Types, Funcs),\n % Gather resources and types that this module uses that my be\n % declared by transitively-imported modules.\n\n ResNames0 = union_list(map(resource_get_resources, Resources))\n `union` union_list(map(func_get_resources, Funcs)),\n ResNames = filter(module_name_filter(ThisModule, ImportModule),\n ResNames0),\n foldl2(maybe_add_implicit_resource, ResNames, !Env, !Core),\n\n TypeNames0 = union_list(map(type_get_types, Types))\n `union` union_list(map(func_get_types, Funcs)),\n TypeNames = filter((pred({N, _}::in) is semidet :-\n module_name_filter(ThisModule, ImportModule, N)\n ), TypeNames0),\n foldl2(maybe_add_implicit_type, TypeNames, !Env, !Core)\n ).\n\n\n:- pred module_name_filter(q_name::in, q_name::in, q_name::in) is semidet.\n\nmodule_name_filter(ThisModule, ImportModule, Name) :-\n q_name_parts(Name, MbModule, _),\n ( MbModule = no,\n unexpected($file, $pred, \"No module part in name\")\n ; MbModule = yes(Module)\n ),\n\n % Exclude resources in the module we're compiling\n \\+ ThisModule = Module,\n\n % Exclude resources in the module being imported\n \\+ ImportModule = Module.\n\n:- pred maybe_add_implicit_resource(q_name::in, env::in, env::out,\n core::in, core::out) is det.\n\nmaybe_add_implicit_resource(Name, !Env, !Core) :-\n ( if env_search_resource(!.Env, Name, _) then\n true\n else\n core_allocate_resource_id(ResId, !Core),\n core_set_resource(ResId, r_abstract(Name), !Core),\n env_add_resource_det(Name, ResId, !Env)\n ).\n\n:- pred maybe_add_implicit_type({q_name, arity}::in, env::in, env::out,\n core::in, core::out) is det.\n\nmaybe_add_implicit_type({Name, Arity}, !Env, !Core) :-\n ( if env_search_type(!.Env, Name, _) then\n true\n else\n core_allocate_type_id(TypeId, !Core),\n env_add_type_det(Name, Arity, TypeId, !Env),\n core_set_type(TypeId, type_init_abstract(Name, Arity, nil_context),\n !Core)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type import_entries == assoc_list(nq_name, import_entry).\n\n:- type import_entry\n ---> ie_resource(resource_id)\n ; ie_type(arity, type_id)\n ; ie_ctor(ctor_id)\n ; ie_func(func_id).\n\n:- pred process_interface_import(env::in, q_name::in,\n import_ast(resource_id, type_id)::in, import_result(import_entries)::out,\n core::in, core::out) is det.\n\nprocess_interface_import(Env, ModuleName, ImportAST, Result, !Core) :-\n ImportAST = import_ast(ModuleNameAST, Context, Entries),\n ( if ModuleNameAST = ModuleName then\n ( Entries = et_interface(Resources, Types, Funcs),\n read_import_import(ModuleName, Env, Resources, Types, Funcs,\n NamePairs, Errors, !Core),\n ( if is_empty(Errors) then\n Result = ok(NamePairs)\n else\n Result = compile_errors(Errors)\n )\n ; Entries = et_typeres(_, _),\n unexpected($file, $pred, \"Typeres\")\n )\n else\n Result = compile_errors(error(Context,\n ce_interface_contains_wrong_module(\n filename(Context ^ c_file), ModuleName, ModuleNameAST)))\n ).\n\n:- pred read_import_import(q_name::in, env::in,\n list({q_name, maybe(ast_resource), resource_id})::in,\n list({q_name, ast_type(q_name), type_id})::in,\n list(q_named(ast_function_decl))::in,\n assoc_list(nq_name, import_entry)::out, errors(compile_error)::out,\n core::in, core::out) is det.\n\nread_import_import(ModuleName, Env, Resources, Types, Funcs, NamePairs,\n Errors, !Core) :-\n map2_foldl(do_import_resource(ModuleName, Env), Resources,\n ResourcePairs, ResourceErrors, !Core),\n\n map2_foldl(do_import_type(ModuleName, Env), Types, TypePairs,\n TypeErrors, !Core),\n\n map2_foldl(do_import_function(ModuleName, Env), Funcs, FuncPairs,\n FunctionErrors, !Core),\n\n NamePairs = ResourcePairs ++ condense(TypePairs) ++ FuncPairs,\n Errors = cord_list_to_cord(ResourceErrors ++ TypeErrors ++\n FunctionErrors).\n\n%-----------------------------------------------------------------------%\n\n:- pred gather_resource({q_name, T, _}::in,\n {q_name, T, resource_id}::out,\n env::in, env::out, core::in, core::out) is det.\n\ngather_resource({Name, Res, _}, {Name, Res, ResId}, !Env, !Core) :-\n core_allocate_resource_id(ResId, !Core),\n ( if env_add_resource(Name, ResId, !Env) then\n true\n else\n compile_error($file, $pred, \"Resource already defined\")\n ).\n\n:- func resource_get_resources({_, maybe(ast_resource), _}) = set(q_name).\n\nresource_get_resources({_, yes(ast_resource(Name, _, _)), _}) =\n make_singleton_set(Name).\nresource_get_resources({_, no, _}) = set.init.\n\n:- pred do_import_resource(q_name::in, env::in,\n {q_name, maybe(ast_resource), resource_id}::in,\n pair(nq_name, import_entry)::out, errors(compile_error)::out,\n core::in, core::out) is det.\n\ndo_import_resource(ModuleName, Env, {Name, Res0, ResId}, NamePair,\n !:Errors, !Core) :-\n !:Errors = init,\n ( if q_name_append(ModuleName, NQName0, Name) then\n NQName = NQName0\n else\n unexpected($file, $pred,\n \"Imported module exports symbols of other module\")\n ),\n\n NamePair = NQName - ie_resource(ResId),\n\n ( Res0 = yes(ast_resource(FromName, _, Context)),\n ( if env_search_resource(Env, FromName, FromRes) then\n core_set_resource(ResId,\n r_other(Name, FromRes, so_private, i_imported, Context), !Core)\n else\n add_error(Context, ce_resource_unknown(FromName), !Errors)\n )\n ; Res0 = no,\n core_set_resource(ResId, r_abstract(Name), !Core)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred gather_types({q_name, ast_type(q_name), _}::in,\n {q_name, ast_type(q_name), type_id}::out, env::in, env::out,\n core::in, core::out) is det.\n\ngather_types({Name, Type, _}, {Name, Type, TypeId}, !Env, !Core) :-\n core_allocate_type_id(TypeId, !Core),\n Arity = type_arity(Type),\n env_add_type_det(Name, Arity, TypeId, !Env).\n\n:- func type_get_types({_, ast_type(_), _}) = set({q_name, arity}).\n\ntype_get_types({_, Type, _}) = Types :-\n ( Type = ast_type(_, Ctors, _, _),\n Types = union_list(map(ctor_get_types, Ctors))\n ; Type = ast_type_abstract(_, _),\n Types = init\n ).\n\n:- func ctor_get_types(at_constructor(_)) = set({q_name, arity}).\n\nctor_get_types(Ctor) = union_list(map(field_get_types, Ctor ^ atc_args)).\n\n:- func field_get_types(at_field) = set({q_name, arity}).\n\nfield_get_types(at_field(_, TypeExpr, _)) = type_expr_get_types(TypeExpr).\n\n:- func type_expr_get_types(ast_type_expr) = set({q_name, arity}).\n\ntype_expr_get_types(ast_type(Name, Args, _)) =\n make_singleton_set({Name, arity(length(Args))}) `union`\n union_list(map(type_expr_get_types, Args)).\ntype_expr_get_types(ast_type_func(Args, Returns, _, _)) =\n union_list(map(type_expr_get_types, Args)) `union`\n union_list(map(type_expr_get_types, Returns)).\ntype_expr_get_types(ast_type_var(_, _)) = init.\n\n:- pred do_import_type(q_name::in, env::in,\n {q_name, ast_type(q_name), type_id}::in,\n assoc_list(nq_name, import_entry)::out, errors(compile_error)::out,\n core::in, core::out) is det.\n\ndo_import_type(ModuleName, Env, {Name, ASTType, TypeId}, NamePairs, Errors,\n !Core) :-\n ( if q_name_append(ModuleName, NQName0, Name) then\n NQName = NQName0\n else\n unexpected($file, $pred,\n \"Imported module exports symbols of other module\")\n ),\n NamePair = NQName - ie_type(type_arity(ASTType), TypeId),\n\n ast_to_core_type_i(func(N) = N, i_imported, Env, Name, TypeId, ASTType, \n Result, !Core),\n ( Result = ok({Type, Ctors}),\n core_set_type(TypeId, Type, !Core),\n CtorNamePairs = map(\n func(C) = q_name_unqual(C ^ cb_name) - ie_ctor(C ^ cb_id),\n Ctors),\n NamePairs = [NamePair | CtorNamePairs],\n Errors = init\n ; Result = errors(Errors),\n NamePairs = []\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func func_get_resources(q_named(ast_function_decl)) = set(q_name).\n\nfunc_get_resources(q_named(_, Func)) =\n list_to_set(map(func(U) = U ^ au_name, Func ^ afd_uses)).\n\n:- func func_get_types(q_named(ast_function_decl)) = set({q_name, arity}).\n\nfunc_get_types(q_named(_, Func)) =\n union_list(map(func(ast_param(_, T)) = type_expr_get_types(T),\n Func ^ afd_params)) `union`\n union_list(map(type_expr_get_types, Func ^ afd_return)).\n\n%-----------------------------------------------------------------------%\n\n:- pred do_import_function(q_name::in, env::in, q_named(ast_function_decl)::in,\n pair(nq_name, import_entry)::out, errors(compile_error)::out,\n core::in, core::out) is det.\n\ndo_import_function(ModuleName, Env, q_named(Name, Decl), NamePair,\n Errors, !Core) :-\n core_allocate_function(FuncId, !Core),\n\n ( if q_name_append(ModuleName, NQName0, Name) then\n NQName = NQName0\n else\n unexpected($file, $pred,\n \"Imported module exports symbols of other module\")\n ),\n NamePair = NQName - ie_func(FuncId),\n\n % Imported functions aren't re-exported, so we annotate it with\n % s_private.\n ast_to_func_decl(!.Core, Env, Name, Decl, s_private, Result),\n ( Result = ok(Function0),\n func_set_imported(Function0, Function),\n core_set_function(FuncId, Function, !Core),\n Errors = init\n ; Result = errors(Errors)\n ).\n\n%-----------------------------------------------------------------------%\n\n % Enrol an import in the import_map into the environment.\n %\n % IO is used only for logging.\n %\n:- pred enroll_import(log_config::in, import_map(import_entries)::in,\n ast_import::in, set(q_name)::in, set(q_name)::out,\n set(q_name)::in, set(q_name)::out, env::in, env::out,\n errors(compile_error)::in, errors(compile_error)::out,\n io::di, io::uo) is det.\n\nenroll_import(Verbose, ImportMap, ast_import(ModuleName, MaybeAsName, Context),\n !AsSet, !DupImportsSet, !Env, !Errors, !IO) :-\n ( MaybeAsName = no,\n AsName = ModuleName\n ; MaybeAsName = yes(AsNameStr),\n AsName = q_name_from_dotted_string_det(AsNameStr)\n ),\n verbose_output(Verbose,\n format(\"Importing %s as %s\\n\",\n [s(q_name_to_string(ModuleName)), s(q_name_to_string(AsName))]),\n !IO),\n\n ( if insert_new(AsName, !AsSet) then\n true\n else\n add_error(Context, ce_import_would_clobber(ModuleName,\n map_maybe(q_name_from_dotted_string_det, MaybeAsName)),\n !Errors)\n ),\n ( if insert_new(ModuleName, !DupImportsSet) then\n true\n else\n add_error(Context, ce_import_duplicate(ModuleName), !Errors)\n ),\n\n map.lookup(ImportMap, ModuleName, ReadResult),\n ( ReadResult = ok(NamePairs),\n foldl(import_add_to_env(AsName), NamePairs, !Env)\n ; ReadResult = read_error(Error),\n add_error(Context, Error, !Errors)\n ; ReadResult = compile_errors(Errors),\n add_errors(Errors, !Errors)\n ).\n\n:- pred import_add_to_env(q_name::in, pair(nq_name, import_entry)::in,\n env::in, env::out) is det.\n\nimport_add_to_env(IntoName, Name0 - Entry, !Env) :-\n Name = q_name_append(IntoName, Name0),\n ( if\n require_complete_switch [Entry]\n ( Entry = ie_resource(ResId),\n env_add_resource(Name, ResId, !Env)\n ; Entry = ie_type(Arity, TypeId),\n env_add_type(Name, Arity, TypeId, !Env)\n ; Entry = ie_ctor(CtorId),\n env_add_constructor(Name, CtorId, !Env)\n ; Entry = ie_func(FuncId),\n env_add_func(Name, FuncId, !Env)\n )\n then\n true\n else\n % XXX Needs to be context of import directive, we'll do a proper\n % error later.\n compile_error($file, $pred, \"Name collision caused by import\")\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.m", "content": "%-----------------------------------------------------------------------%\n% Plasma pre-core representation\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module represents the pre-core representation.\n%\n%-----------------------------------------------------------------------%\n:- module pre.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- include_module pre.ast_to_core.\n:- include_module pre.env.\n:- include_module pre.import.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- include_module pre.bang.\n:- include_module pre.branches.\n:- include_module pre.closures.\n:- include_module pre.from_ast.\n:- include_module pre.pre_ds.\n:- include_module pre.pretty.\n:- include_module pre.to_core.\n:- include_module pre.util.\n\n%-----------------------------------------------------------------------%\n\n\n" }, { "path": "src/pre.pre_ds.m", "content": "%-----------------------------------------------------------------------%\n% Plasma pre-core representation\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module represents the pre-core representation.\n%\n%-----------------------------------------------------------------------%\n:- module pre.pre_ds.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module list.\n:- import_module map.\n:- import_module maybe.\n:- import_module set.\n\n:- import_module context.\n:- import_module common_types.\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\n % Compared with the AST representation, the pre representation has\n % variables resolved, and restricts where expressions can appear\n % (they're not allowed as the switched-on variable in switches or return\n % expressions).\n %\n:- type pre_function\n ---> pre_function(\n f_func_id :: func_id,\n f_varmap :: varmap,\n f_param_vars :: list(var_or_wildcard(var)),\n f_arity :: arity,\n f_body :: pre_statements,\n f_context :: context\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type pre_statements == list(pre_statement).\n\n:- type pre_statement\n ---> pre_statement(\n s_type :: pre_stmt_type,\n s_info :: pre_stmt_info\n ).\n\n:- type pre_stmt_type\n ---> s_call(pre_call)\n ; s_decl_vars(list(var))\n ; s_assign(list(var_or_wildcard(var)), list(pre_expr))\n ; s_return(list(var))\n ; s_match(var, list(pre_case)).\n\n:- type pre_stmt_info\n ---> stmt_info(\n si_context :: context,\n\n % Use vars the set of variables whose values are needed\n % by this computation. They appear on the LHS of\n % assignments or anywhere within other statement types.\n si_use_vars :: set(var),\n\n % Def vars is the set of variables that are computed by\n % this computation. They appear on the RHS of\n % assignments. They may intersect with use vars, for\n % example if this is a compound statement containing an\n % assignment of a variable followed by the use of the\n % same variable.\n si_def_vars :: set(var),\n\n % Whether the end of this statment is reachable.\n si_reachable :: stmt_reachable\n ).\n\n:- type stmt_reachable\n ---> stmt_always_fallsthrough\n % NOTE: All visible cases are covered, uncovered cases cannot be\n % detected until after typechecking.\n ; stmt_always_returns\n ; stmt_may_return.\n\n:- type pre_call\n % XXX: Maybe use only variables as call arguments?\n ---> pre_call(func_id, list(pre_expr), with_bang)\n ; pre_ho_call(pre_expr, list(pre_expr), with_bang).\n\n:- type with_bang\n ---> with_bang\n ; without_bang.\n\n:- type pre_case\n ---> pre_case(pre_pattern, pre_statements).\n\n:- type pre_pattern\n ---> p_number(int)\n ; p_var(var)\n % The pattern is for one of the possible constructors\n ; p_constr(set(ctor_id), list(pre_pattern))\n ; p_wildcard.\n\n:- type pre_expr\n ---> e_call(pre_call)\n ; e_match(pre_expr, list(pre_expr_case))\n ; e_var(var)\n ; e_construction(\n set(ctor_id),\n list(pre_expr)\n )\n ; e_lambda(pre_lambda)\n ; e_constant(const_type).\n\n:- type pre_expr_case\n ---> pre_e_case(pre_pattern, list(pre_expr)).\n\n:- type pre_lambda\n ---> pre_lambda(\n pl_id :: func_id,\n pl_params :: list(var_or_wildcard(var)),\n % Filled in during nonlocals processing.\n pl_captured :: maybe(set(var)),\n pl_arity :: arity,\n pl_body :: pre_statements\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func stmt_all_vars(pre_statement) = set(var).\n\n:- func pattern_all_vars(pre_pattern) = set(var).\n\n:- pred stmt_rename(set(var)::in, pre_statement::in, pre_statement::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\n:- pred pat_rename(set(var)::in, pre_pattern::in, pre_pattern::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module require.\n\n:- import_module util.\n:- import_module util.mercury.\n\n%-----------------------------------------------------------------------%\n\nstmt_all_vars(pre_statement(Type, _)) = Vars :-\n ( Type = s_call(Call),\n Vars = call_all_vars(Call)\n ; Type = s_decl_vars(VarsList),\n Vars = list_to_set(VarsList)\n ; Type = s_assign(LVarsOrWildcards, Exprs),\n filter_map(vow_is_var, LVarsOrWildcards, LVars),\n Vars = list_to_set(LVars) `union`\n union_list(map(expr_all_vars, Exprs))\n ; Type = s_return(RVars),\n Vars = list_to_set(RVars)\n ; Type = s_match(Var, Cases),\n Vars = make_singleton_set(Var) `union`\n union_list(map(case_all_vars, Cases))\n ).\n\n:- func case_all_vars(pre_case) = set(var).\n\ncase_all_vars(pre_case(Pat, Stmts)) = pattern_all_vars(Pat) `union`\n union_list(map(stmt_all_vars, Stmts)).\n\npattern_all_vars(p_number(_)) = set.init.\npattern_all_vars(p_var(Var)) = make_singleton_set(Var).\npattern_all_vars(p_wildcard) = set.init.\npattern_all_vars(p_constr(_, Args)) =\n union_list(map(pattern_all_vars, Args)).\n\n:- func expr_all_vars(pre_expr) = set(var).\n\nexpr_all_vars(e_call(Call)) = call_all_vars(Call).\nexpr_all_vars(e_match(MatchExpr, Cases)) = expr_all_vars(MatchExpr) `union`\n union_list(map(func(pre_e_case(Pat, Expr)) =\n pattern_all_vars(Pat) `union` union_list(map(expr_all_vars, Expr)),\n Cases)).\nexpr_all_vars(e_var(Var)) = make_singleton_set(Var).\nexpr_all_vars(e_construction(_, Args)) = union_list(map(expr_all_vars, Args)).\nexpr_all_vars(e_lambda(Lambda)) =\n union_list(map(stmt_all_vars, Body)) `union` list_to_set(ParamVars) :-\n Body = Lambda ^ pl_body,\n filter_map(vow_is_var, Lambda ^ pl_params, ParamVars).\nexpr_all_vars(e_constant(_)) = set.init.\n\n:- func call_all_vars(pre_call) = set(var).\n\ncall_all_vars(pre_call(_, Exprs, _)) =\n union_list(map(expr_all_vars, Exprs)).\ncall_all_vars(pre_ho_call(CalleeExpr, ArgsExprs, _)) =\n union_list(map(expr_all_vars, ArgsExprs)) `union` expr_all_vars(CalleeExpr).\n\n%-----------------------------------------------------------------------%\n\nstmt_rename(Vars, pre_statement(Type0, Info0), pre_statement(Type, Info),\n !Renaming, !Varmap) :-\n ( Type0 = s_call(Call0),\n call_rename(Vars, Call0, Call, !Renaming, !Varmap),\n Type = s_call(Call)\n ; Type0 = s_decl_vars(DVars0),\n map_foldl2(var_rename(Vars), DVars0, DVars, !Renaming, !Varmap),\n Type = s_decl_vars(DVars)\n ; Type0 = s_assign(LVars0, Exprs0),\n map_foldl2(var_or_wild_rename(Vars), LVars0, LVars, !Renaming, !Varmap),\n map_foldl2(expr_rename(Vars), Exprs0, Exprs, !Renaming, !Varmap),\n Type = s_assign(LVars, Exprs)\n ; Type0 = s_return(RVars0),\n map_foldl2(var_rename(Vars), RVars0, RVars, !Renaming, !Varmap),\n Type = s_return(RVars)\n ; Type0 = s_match(Var0, Cases0),\n var_rename(Vars, Var0, Var, !Renaming, !Varmap),\n map_foldl2(case_rename(Vars), Cases0, Cases, !Renaming, !Varmap),\n Type = s_match(Var, Cases)\n ),\n\n Info0 = stmt_info(Context, UseVars0, DefVars0, StmtReturns),\n set_map_foldl2(var_rename(Vars), UseVars0, UseVars, !Renaming, !Varmap),\n set_map_foldl2(var_rename(Vars), DefVars0, DefVars, !Renaming, !Varmap),\n Info = stmt_info(Context, UseVars, DefVars, StmtReturns).\n\n:- pred case_rename(set(var)::in, pre_case::in, pre_case::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\ncase_rename(Vars, pre_case(Pat0, Stmts0), pre_case(Pat, Stmts),\n !Renaming, !Varmap) :-\n pat_rename(Vars, Pat0, Pat, !Renaming, !Varmap),\n map_foldl2(stmt_rename(Vars), Stmts0, Stmts, !Renaming, !Varmap).\n\npat_rename(_, p_number(N), p_number(N), !Renaming, !Varmap).\npat_rename(Vars, p_var(Var0), p_var(Var), !Renaming, !Varmap) :-\n var_rename(Vars, Var0, Var, !Renaming, !Varmap).\npat_rename(_, p_wildcard, p_wildcard, !Renaming, !Varmap).\npat_rename(Vars, p_constr(Cs, Args0), p_constr(Cs, Args), !Renaming, !Varmap) :-\n map_foldl2(pat_rename(Vars), Args0, Args, !Renaming, !Varmap).\n\n:- pred expr_rename(set(var)::in, pre_expr::in, pre_expr::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\nexpr_rename(Vars, e_call(Call0), e_call(Call), !Renaming, !Varmap) :-\n call_rename(Vars, Call0, Call, !Renaming, !Varmap).\nexpr_rename(Vars, e_match(Expr0, Cases0), e_match(Expr, Cases), !Renaming,\n !Varmap) :-\n expr_rename(Vars, Expr0, Expr, !Renaming, !Varmap),\n map_foldl2(expr_case_rename(Vars), Cases0, Cases, !Renaming, !Varmap).\nexpr_rename(Vars, e_var(Var0), e_var(Var), !Renaming, !Varmap) :-\n var_rename(Vars, Var0, Var, !Renaming, !Varmap).\nexpr_rename(Vars, e_construction(Cs, Args0), e_construction(Cs, Args),\n !Renaming, !Varmap) :-\n map_foldl2(expr_rename(Vars), Args0, Args, !Renaming, !Varmap).\nexpr_rename(Vars, e_lambda(!.Lambda), e_lambda(!:Lambda), !Renaming, !Varmap) :-\n map_foldl2(var_or_wild_rename(Vars), !.Lambda ^ pl_params, Params,\n !Renaming, !Varmap),\n MaybeCaptured0 = !.Lambda ^ pl_captured,\n ( MaybeCaptured0 = yes(Captured0),\n set_rename(Vars, Captured0, Captured, !Renaming, !Varmap),\n !Lambda ^ pl_captured := yes(Captured)\n ; MaybeCaptured0 = no\n ),\n map_foldl2(stmt_rename(Vars), !.Lambda ^ pl_body, Body,\n !Renaming, !Varmap),\n !Lambda ^ pl_params := Params,\n !Lambda ^ pl_body := Body.\nexpr_rename(_, e_constant(C), e_constant(C), !Renaming, !Varmap).\n\n:- pred call_rename(set(var)::in, pre_call::in, pre_call::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\ncall_rename(Vars, pre_call(Func, Exprs0, Bang), pre_call(Func, Exprs, Bang),\n !Renaming, !Varmap) :-\n map_foldl2(expr_rename(Vars), Exprs0, Exprs, !Renaming, !Varmap).\ncall_rename(Vars, pre_ho_call(CalleeExpr0, ArgExprs0, Bang),\n pre_ho_call(CalleeExpr, ArgExprs, Bang), !Renaming, !Varmap) :-\n expr_rename(Vars, CalleeExpr0, CalleeExpr, !Renaming, !Varmap),\n map_foldl2(expr_rename(Vars), ArgExprs0, ArgExprs, !Renaming, !Varmap).\n\n:- pred expr_case_rename(set(var)::in,\n pre_expr_case::in, pre_expr_case::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\nexpr_case_rename(Vars, pre_e_case(Pat0, Exprs0), pre_e_case(Pat, Exprs),\n !Renaming, !Varmap) :-\n pat_rename(Vars, Pat0, Pat, !Renaming, !Varmap),\n map_foldl2(expr_rename(Vars), Exprs0, Exprs, !Renaming, !Varmap).\n\n:- pred set_rename(set(var)::in, set(var)::in, set(var)::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\nset_rename(Vars, !Set, !Renaming, !Varmap) :-\n fold3(set_rename_2(Vars), !.Set, set.init, !:Set, !Renaming, !Varmap).\n\n:- pred set_rename_2(set(var)::in, var::in, set(var)::in, set(var)::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\nset_rename_2(Vars, Var0, !Set, !Renaming, !Varmap) :-\n var_rename(Vars, Var0, Var, !Renaming, !Varmap),\n ( if insert_new(Var, !Set) then\n true\n else\n unexpected($file, $pred, \"Renaming vars in a set is broken\")\n ).\n\n:- pred var_or_wild_rename(set(var)::in,\n var_or_wildcard(var)::in, var_or_wildcard(var)::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\nvar_or_wild_rename(Vars, var(Var0), var(Var), !Renaming, !Varmap) :-\n var_rename(Vars, Var0, Var, !Renaming, !Varmap).\nvar_or_wild_rename(_, wildcard, wildcard, !Renaming, !Varmap).\n\n:- pred var_rename(set(var)::in, var::in, var::out,\n map(var, var)::in, map(var, var)::out, varmap::in, varmap::out) is det.\n\nvar_rename(Vars, Var0, Var, !Renaming, !Varmap) :-\n ( if member(Var0, Vars) then\n ( if search(!.Renaming, Var0, VarPrime) then\n Var = VarPrime\n else\n add_fresh_var(get_var_name_no_suffix(!.Varmap, Var0), Var, !Varmap),\n det_insert(Var0, Var, !Renaming)\n )\n else\n Var = Var0\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.pretty.m", "content": "%-----------------------------------------------------------------------%\n% Plasma pre-core pretty printer\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module defines a pretty printer for the pre-core representation.\n%\n%-----------------------------------------------------------------------%\n:- module pre.pretty.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module cord.\n:- import_module map.\n\n% Used to lookup function names, we could decouple this better.\n:- import_module core.\n\n:- import_module common_types.\n:- import_module pre.pre_ds.\n\n:- func pre_pretty(core, map(func_id, pre_function)) = cord(string).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module list.\n:- import_module maybe.\n:- import_module pair.\n:- import_module set.\n:- import_module string.\n\n:- import_module context.\n:- import_module q_name.\n:- import_module core.pretty.\n:- import_module util.\n:- import_module util.mercury.\n:- import_module util.pretty.\n:- import_module varmap.\n\n%-----------------------------------------------------------------------%\n\npre_pretty(Core, Map) = pretty(default_options, 0, Pretty) :-\n Pretty = [p_list(list_join([p_nl_hard],\n map(func_pretty(Core), to_assoc_list(Map))))].\n\n:- type pretty_info\n ---> pretty_info(\n pi_varmap :: varmap,\n pi_core :: core\n ).\n\n:- func func_pretty(core, pair(func_id, pre_function)) = pretty.\n\nfunc_pretty(Core, FuncId - Func) =\n procish_pretty(Info, FuncId, ParamVars, yes(init), Body) :-\n ParamVars = Func ^ f_param_vars,\n Body = Func ^ f_body,\n Varmap = Func ^ f_varmap,\n Info = pretty_info(Varmap, Core).\n\n:- func procish_pretty(pretty_info, func_id, list(var_or_wildcard(var)),\n maybe(set(var)), pre_statements) = pretty.\n\nprocish_pretty(Info, FuncId, ParamVars, MaybeCaptured, Body) =\n p_group_curly(\n [q_name_pretty(core_lookup_function_name(Core, FuncId)),\n p_str(\"(\")] ++\n pretty_comma_seperated(\n map(var_or_wild_pretty(Varmap), ParamVars)) ++\n [p_str(\")\")] ++ CapturedPretty,\n singleton(\"{\"),\n stmts_pretty(Info, Body),\n singleton(\"}\")) :-\n pretty_info(Varmap, Core) = Info,\n ( if\n MaybeCaptured = yes(Captured),\n not is_empty(Captured)\n then\n CapturedPretty = [p_nl_hard, p_str(\"// Captured: \"),\n vars_set_pretty(Varmap, Captured)]\n else\n CapturedPretty = []\n ).\n\n:- func stmts_pretty(pretty_info, pre_statements) = list(pretty).\n\nstmts_pretty(Info, Stmts) =\n condense(list_join([[p_nl_double]], map(stmt_pretty(Info), Stmts))).\n\n:- func stmt_pretty(pretty_info, pre_statement) = list(pretty).\n\nstmt_pretty(Info, pre_statement(Type, StmtInfo)) =\n PrettyInfo1 ++ [p_nl_hard, PrettyStmt] ++\n PrettyInfo2 :-\n Varmap = Info ^ pi_varmap,\n\n StmtInfo = stmt_info(Context, UseVars, DefVars, StmtReturns),\n PrettyInfo1 = [p_comment(singleton(\"// \"),\n [p_str(context_string(Context)), p_nl_hard,\n p_str(\"Use vars: \"), vars_set_pretty(Varmap, UseVars)])],\n PrettyInfo2 = [p_comment(singleton(\"// \"),\n [p_str(\"Def vars: \"), vars_set_pretty(Varmap, DefVars), p_nl_hard,\n p_str(\"Reachable: \"), p_str(string(StmtReturns))])],\n\n ( Type = s_call(Call),\n PrettyStmt = call_pretty(Info, Call)\n ; Type = s_decl_vars(Vars),\n PrettyStmt = p_expr([p_str(\"var \"), vars_pretty(Varmap, Vars)])\n ; Type = s_assign(Vars, Exprs),\n PrettyStmt = p_expr(pretty_comma_seperated(\n map(var_or_wild_pretty(Varmap), Vars)) ++\n [p_spc, p_nl_soft, p_str(\"= \"),\n p_expr(pretty_comma_seperated(\n map(expr_pretty(Info), Exprs)))])\n ; Type = s_return(Vars),\n PrettyStmt = p_expr([p_str(\"return \"),\n vars_pretty(Varmap, Vars)])\n ; Type = s_match(Var, Cases),\n PrettyStmt = p_group_curly(\n [p_str(\"match (\"), var_pretty(Varmap, Var), p_str(\")\")],\n singleton(\"{\"),\n list_join([p_nl_hard], map(case_pretty(Info), Cases)),\n singleton(\"}\"))\n ).\n\n:- func case_pretty(pretty_info, pre_case) = pretty.\n\ncase_pretty(Info, pre_case(Pattern, Stmts)) = p_group_curly(\n [p_str(\"case \"), pattern_pretty(Info, Pattern), p_str(\" ->\")],\n singleton(\"{\"),\n stmts_pretty(Info, Stmts),\n singleton(\"}\")).\n\n:- func pattern_pretty(pretty_info, pre_pattern) = pretty.\n\npattern_pretty(_, p_number(Num)) = p_str(string(Num)).\npattern_pretty(Info, p_var(Var)) = var_pretty(Info ^ pi_varmap, Var).\npattern_pretty(_, p_wildcard) = p_str(\"_\").\npattern_pretty(Info, p_constr(CtorIds, Args)) =\n pretty_optional_args(IdPretty, ArgsPretty) :-\n IdPretty = constructor_name_pretty(Info ^ pi_core, CtorIds),\n ArgsPretty = map(pattern_pretty(Info), Args).\n\n:- func expr_pretty(pretty_info, pre_expr) = pretty.\n\nexpr_pretty(Info, e_call(Call)) = call_pretty(Info, Call).\nexpr_pretty(Info, e_match(Expr, Cases)) =\n p_expr([p_str(\"match (\"), expr_pretty(Info, Expr), p_str(\")\"), p_nl_hard] ++\n list_join([p_nl_hard], map(case_expr_pretty(Info), Cases))).\nexpr_pretty(Info, e_var(Var)) = var_pretty(Info ^ pi_varmap, Var).\nexpr_pretty(Info, e_construction(CtorIds, Args)) =\n pretty_optional_args(IdPretty, ArgsPretty) :-\n IdPretty = constructor_name_pretty(Info ^ pi_core, CtorIds),\n ArgsPretty = map(expr_pretty(Info), Args).\nexpr_pretty(Info,\n e_lambda(pre_lambda(FuncId, Params, MaybeCaptured, _, Body))) =\n procish_pretty(Info, FuncId, Params, MaybeCaptured, Body).\nexpr_pretty(Info, e_constant(Const)) =\n const_pretty(\n func(F) = q_name_pretty(core_lookup_function_name(Info ^ pi_core, F)),\n constructor_name_pretty(Info ^ pi_core),\n Const).\n\n:- func call_pretty(pretty_info, pre_call) = pretty.\n\ncall_pretty(Info, Call) = Pretty :-\n ( Call = pre_call(FuncId, Args, WithBang),\n CalleePretty = q_name_pretty(\n core_lookup_function_name(Info ^ pi_core, FuncId))\n ; Call = pre_ho_call(Callee, Args, WithBang),\n CalleePretty = expr_pretty(Info, Callee)\n ),\n ( WithBang = with_bang,\n BangPretty = [p_str(\"!\")]\n ; WithBang = without_bang,\n BangPretty = []\n ),\n Pretty = pretty_callish(p_expr([CalleePretty] ++ BangPretty),\n map(expr_pretty(Info), Args)).\n\n:- func case_expr_pretty(pretty_info, pre_expr_case) = pretty.\n\ncase_expr_pretty(Info, pre_e_case(Pat, Expr)) =\n p_expr([pattern_pretty(Info, Pat), p_spc, p_nl_soft, p_str(\"-> \"),\n p_list(pretty_comma_seperated(map(expr_pretty(Info), Expr)))]).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.to_core.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pre.to_core.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Plasma parse tree to core representation conversion\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module core.\n:- import_module common_types.\n:- import_module pre.pre_ds.\n\n%-----------------------------------------------------------------------%\n\n:- pred pre_to_core(func_id::in, pre_function::in, core::in, core::out)\n is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module int.\n:- import_module list.\n:- import_module maybe.\n:- import_module require.\n:- import_module set.\n:- import_module string.\n\n:- import_module context.\n:- import_module core.code.\n:- import_module core.function.\n:- import_module pre.util.\n:- import_module varmap.\n:- import_module util.\n:- import_module util.my_exception.\n\n%-----------------------------------------------------------------------%\n\npre_to_core(FuncId, Func, !Core) :-\n Func = pre_function(_, Varmap, Params, _, Body, _),\n pre_to_core_func(FuncId, Params, [], Body, Varmap, !Core).\n\n:- pred pre_to_core_func(func_id::in, list(var_or_wildcard(var))::in,\n list(var)::in, pre_statements::in, varmap::in, core::in, core::out) is det.\n\npre_to_core_func(FuncId, Params, Captured, Body0, !.Varmap, !Core) :-\n map_foldl(var_or_make_var, Params, ParamVars,\n !Varmap),\n foldl(pre_to_core_lambda(!.Varmap),\n get_all_lambdas_stmts(Body0), !Core),\n ParamVarsSet = list_to_set(ParamVars),\n pre_to_core_stmts(ParamVarsSet, Body0, Body1, !Varmap),\n expr_make_vars_unique(Body1, Body, set.init, _, !Varmap),\n core_get_function_det(!.Core, FuncId, Function0),\n func_set_body(!.Varmap, ParamVars, Captured, Body, Function0, Function),\n core_set_function(FuncId, Function, !Core).\n\n:- pred pre_to_core_stmts(set(var)::in, pre_statements::in, expr::out,\n varmap::in, varmap::out) is det.\n\npre_to_core_stmts(_, [], empty_tuple, !Varmap).\npre_to_core_stmts(DeclVars0, Stmts0@[_ | _], Expr, !Varmap) :-\n det_split_last(Stmts0, Stmts, LastStmt),\n ( Stmts = [],\n pre_to_core_stmt(LastStmt, LastExpr, Vars, DeclVars0, _, !Varmap),\n terminate_let(Vars, [], LastExpr, Expr)\n ; Stmts = [_ | _],\n map_foldl2(\n (pred(S::in, e_let(V, E)::out, Dv0::in, Dv::out, Vm0::in, Vm::out)\n is det :-\n pre_to_core_stmt(S, E, V, Dv0, Dv, Vm0, Vm)\n ), Stmts, Lets, DeclVars0, DeclVars, !Varmap),\n pre_to_core_stmt(LastStmt, LastExpr, Vars, DeclVars, _, !Varmap),\n terminate_let(Vars, Lets, LastExpr, Expr)\n ).\n\n:- pred terminate_let(list(var)::in, list(expr_let)::in,\n expr::in, expr::out) is det.\n\nterminate_let([], [], Expr, Expr).\nterminate_let([], Lets@[_ | _], LastExpr, Expr) :-\n Expr = expr(e_lets(Lets, LastExpr), LastExpr ^ e_info).\nterminate_let(Vars@[_ | _], Lets0, LastExpr, Expr) :-\n Lets = Lets0 ++ [e_let(Vars, LastExpr)],\n Expr = expr(e_lets(Lets, empty_tuple), LastExpr ^ e_info).\n\n % pre_to_core_stmt(Statement, !Stmts, Expr, !DeclVars, !Varmap).\n %\n % Build Expr from Statement and maybe some of !Stmts.\n %\n:- pred pre_to_core_stmt(pre_statement::in, expr::out, list(var)::out,\n set(var)::in, set(var)::out, varmap::in, varmap::out) is det.\n\npre_to_core_stmt(Stmt, Expr, DefnVars, !DeclVars, !Varmap) :-\n Stmt = pre_statement(StmtType, Info),\n Context = Info ^ si_context,\n ( StmtType = s_call(Call),\n pre_to_core_call(Context, Call, Expr, !Varmap),\n DefnVars = []\n ; StmtType = s_decl_vars(NewDeclVars),\n !:DeclVars = !.DeclVars `union` list_to_set(NewDeclVars),\n Expr = empty_tuple,\n DefnVars = []\n ; StmtType = s_assign(Vars0, PreExprs),\n map_foldl(var_or_make_var, Vars0, Vars, !Varmap),\n map_foldl(pre_to_core_expr(Context), PreExprs, Exprs, !Varmap),\n Expr = expr(e_tuple(Exprs), code_info_init(o_user_body(Context))),\n DefnVars = Vars\n ; StmtType = s_return(Vars),\n CodeInfo = code_info_init(o_user_return(Context)),\n Expr = expr(\n e_tuple(map((func(V) = expr(e_var(V), CodeInfo)), Vars)),\n CodeInfo),\n DefnVars = []\n ; StmtType = s_match(Var, Cases0),\n % For the initial version we require that all cases fall through, or\n % tha all will execute a return statement.\n Reachable = Info ^ si_reachable,\n ( Reachable = stmt_always_fallsthrough\n ; Reachable = stmt_always_returns\n ; Reachable = stmt_may_return,\n my_exception.sorry($file, $pred, Context,\n \"Cannot handle some branches returning and others \" ++\n \"falling-through\")\n ),\n\n % This statement will become a let expression, binding the\n % variables produced on all branches that are declared outside\n % of the statement.\n ProdVarsSet = Info ^ si_def_vars `intersect` !.DeclVars,\n % Within each case we have to rename these variables. then we\n % can create an expression at the end that returns their values.\n map_foldl(pre_to_core_case_rename(!.DeclVars, ProdVarsSet),\n Cases0, Cases, !Varmap),\n\n MatchInfo = code_info_init(o_user_body(Context)),\n DefnVars = to_sorted_list(ProdVarsSet),\n\n Expr = expr(e_match(Var, Cases), MatchInfo)\n ).\n\n:- pred pre_to_core_case_rename(set(var)::in, set(var)::in,\n pre_case::in, expr_case::out, varmap::in, varmap::out) is det.\n\npre_to_core_case_rename(!.DeclVars, VarsSet,\n pre_case(Pattern0, Stmts), e_case(Pattern, Expr), !Varmap) :-\n pre_to_core_pattern(Pattern0, Pattern1, !DeclVars, !Varmap),\n pre_to_core_stmts(!.DeclVars, Stmts, Expr0, !Varmap),\n ( if not is_empty(VarsSet) then\n make_renaming(VarsSet, Renaming, !Varmap),\n rename_pattern(Renaming, Pattern1, Pattern),\n Info = code_info_init(o_introduced),\n ReturnExpr = expr(e_tuple(map(func(V) = expr(e_var(V), Info),\n to_sorted_list(VarsSet))),\n Info),\n insert_result_expr(ReturnExpr, Expr0, Expr1),\n rename_expr(Renaming, Expr1, Expr)\n else\n Pattern = Pattern1,\n Expr = Expr0\n ).\n\n:- pred pre_to_core_pattern(pre_pattern::in, expr_pattern::out,\n set(var)::in, set(var)::out, varmap::in, varmap::out) is det.\n\npre_to_core_pattern(p_number(Num), p_num(Num), !DeclVars, !Varmap).\npre_to_core_pattern(p_var(Var), p_variable(Var), !DeclVars, !Varmap) :-\n set.insert(Var, !DeclVars).\npre_to_core_pattern(p_wildcard, p_wildcard, !DeclVars, !Varmap).\npre_to_core_pattern(p_constr(Constrs, Args0),\n p_ctor(Constrs, Args), !DeclVars, !Varmap) :-\n map_foldl(make_pattern_arg_var, Args0, Args, !Varmap),\n !:DeclVars = !.DeclVars `union` list_to_set(Args).\n\n:- pred make_pattern_arg_var(pre_pattern::in, var::out,\n varmap::in, varmap::out) is det.\n\nmake_pattern_arg_var(p_number(_), _, !Varmap) :-\n my_exception.sorry($file, $pred,\n \"Nested pattern matching (number within other pattern)\").\nmake_pattern_arg_var(p_constr(_, _), _, !Varmap) :-\n my_exception.sorry($file, $pred,\n \"Nested pattern matching (constructor within other pattern)\").\nmake_pattern_arg_var(p_var(Var), Var, !Varmap).\nmake_pattern_arg_var(p_wildcard, Var, !Varmap) :-\n add_anon_var(Var, !Varmap).\n\n:- pred pre_to_core_expr(context::in, pre_expr::in, expr::out,\n varmap::in, varmap::out) is det.\n\npre_to_core_expr(Context, e_call(Call), Expr, !Varmap) :-\n pre_to_core_call(Context, Call, Expr, !Varmap).\npre_to_core_expr(Context, e_match(MatchExpr0, Cases), Expr, !Varmap) :-\n pre_to_core_expr(Context, MatchExpr0, MatchExpr, !Varmap),\n map_foldl(pre_to_core_expr_case(Context), Cases, CasesExprs, !Varmap),\n\n add_anon_var(Var, !Varmap),\n CodeInfo = code_info_init(o_user_body(Context)),\n Expr = expr(e_lets([e_let([Var], MatchExpr)], CasesExpr), CodeInfo),\n CasesExpr = expr(e_match(Var, CasesExprs), CodeInfo).\npre_to_core_expr(Context, e_var(Var),\n expr(e_var(Var), code_info_init(o_user_body(Context))), !Varmap).\npre_to_core_expr(Context, e_construction(CtorIds, Args0), Expr, !Varmap) :-\n make_arg_exprs(Context, Args0, Args, LetExpr, !Varmap),\n Expr = expr(e_lets([e_let(Args, LetExpr)],\n expr(e_construction(CtorIds, Args),\n code_info_init(o_user_body(Context)))),\n code_info_init(o_user_body(Context))).\npre_to_core_expr(Context, e_lambda(Lambda), Expr, !Varmap) :-\n pre_lambda(FuncId, _, MaybeCaptured, _, _) = Lambda,\n ( MaybeCaptured = yes(Captured),\n ( if is_empty(Captured) then\n % This isn't a closure so we can generate a function reference\n % instead.\n ExprType = e_constant(c_func(FuncId))\n else\n CapturedList = to_sorted_list(Captured),\n ExprType = e_closure(FuncId, CapturedList)\n )\n ; MaybeCaptured = no,\n unexpected($file, $pred, \"e_lambda with no captured set\")\n ),\n Expr = expr(ExprType, code_info_init(o_user_body(Context))).\npre_to_core_expr(Context, e_constant(Const), expr(e_constant(Const),\n code_info_init(o_user_body(Context))), !Varmap).\n\n:- pred pre_to_core_call(context::in, pre_call::in, expr::out,\n varmap::in, varmap::out) is det.\n\npre_to_core_call(Context, Call, Expr, !Varmap) :-\n CodeInfo0 = code_info_init(o_user_body(Context)),\n ( Call = pre_call(_, Args0, WithBang)\n ; Call = pre_ho_call(_, Args0, WithBang)\n ),\n ( WithBang = without_bang,\n CodeInfo = CodeInfo0\n ; WithBang = with_bang,\n code_info_set_bang_marker(has_bang_marker, CodeInfo0, CodeInfo)\n ),\n make_arg_exprs(Context, Args0, Args, ArgsLetExpr, !Varmap),\n ( Call = pre_call(Callee, _, _),\n % We could fill in resources here but we do that after type-checking\n % anyway and re-check it then.\n CallExpr = expr(e_call(c_plain(Callee), Args, unknown_resources),\n CodeInfo)\n ; Call = pre_ho_call(CalleeExpr0, _, _),\n add_anon_var(CalleeVar, !Varmap),\n pre_to_core_expr(Context, CalleeExpr0, CalleeExpr, !Varmap),\n CallExpr = expr(e_lets([e_let([CalleeVar], CalleeExpr)],\n expr(e_call(c_ho(CalleeVar), Args, unknown_resources),\n CodeInfo)),\n code_info_init(o_user_body(Context)))\n ),\n ( Args = [],\n Expr = CallExpr\n ; Args = [_ | _],\n Expr = expr(e_lets([e_let(Args, ArgsLetExpr)], CallExpr),\n code_info_init(o_user_body(Context)))\n ).\n\n:- pred make_arg_exprs(context::in, list(pre_expr)::in, list(var)::out,\n expr::out, varmap::in, varmap::out) is det.\n\nmake_arg_exprs(Context, Args0, Args, LetExpr, !Varmap) :-\n map_foldl(pre_to_core_expr(Context), Args0, ArgExprs, !Varmap),\n LetExpr = expr(e_tuple(ArgExprs), code_info_init(o_introduced)),\n make_arg_vars(length(Args0), Args, !Varmap).\n\n:- pred pre_to_core_expr_case(context::in, pre_expr_case::in, expr_case::out,\n varmap::in, varmap::out) is det.\n\npre_to_core_expr_case(Context, pre_e_case(Pat0, Exprs0), e_case(Pat, Expr),\n !Varmap) :-\n % DeclVars is used when the inside of the match is a series of\n % statements.\n pre_to_core_pattern(Pat0, Pat, init, _DeclVars, !Varmap),\n map_foldl(pre_to_core_expr(Context), Exprs0, Exprs, !Varmap),\n ( Exprs = [],\n unexpected($file, $pred, \"Empty expressions in case\")\n ; Exprs = [Expr]\n ; Exprs = [_, _ | _],\n Expr = expr(e_tuple(Exprs), code_info_init(o_user_body(Context)))\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred pre_to_core_lambda(varmap, pre_lambda, core, core).\n:- mode pre_to_core_lambda(in, in, in, out) is det.\n\npre_to_core_lambda(Varmap, pre_lambda(FuncId, Params, MaybeCaptured, _, Body),\n !Core) :-\n ( MaybeCaptured = yes(Captured),\n CapturedList = set.to_sorted_list(Captured),\n pre_to_core_func(FuncId, Params, CapturedList, Body, Varmap, !Core)\n ; MaybeCaptured = no,\n unexpected($file, $pred, \"Unfilled capture set\")\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred make_arg_vars(int::in, list(var)::out, varmap::in, varmap::out)\n is det.\n\nmake_arg_vars(Num, Vars, !Varmap) :-\n ( if Num = 0 then\n Vars = []\n else\n make_arg_vars(Num - 1, Vars0, !Varmap),\n add_anon_var(Var, !Varmap),\n Vars = [Var | Vars0]\n ).\n\n:- func empty_tuple = expr.\n\nempty_tuple =\n expr(e_tuple([]), code_info_init(o_introduced)).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pre.util.m", "content": "%-----------------------------------------------------------------------%\n% Plasma AST symbol resolution\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module computes nonlocals within the pre-core representation.\n%\n%-----------------------------------------------------------------------%\n:- module pre.util.\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module list.\n\n:- import_module pre.pre_ds.\n\n%-----------------------------------------------------------------------%\n\n:- pred update_lambdas_this_stmt(pred(pre_lambda, pre_lambda, T, T),\n pre_statement, pre_statement, T, T).\n:- mode update_lambdas_this_stmt(pred(in, out, in, out) is det,\n in, out, in, out) is det.\n\n:- pred update_lambdas_this_stmt_2(pred(pre_lambda, pre_lambda, T, T, U, U),\n pre_statement, pre_statement, T, T, U, U).\n:- mode update_lambdas_this_stmt_2(pred(in, out, in, out, in, out) is det,\n in, out, in, out, in, out) is det.\n\n % This returns only the lambdas found directly. it won't recurse into\n % lambdas and return any inside them.\n %\n:- func get_all_lambdas_stmts(pre_statements) = list(pre_lambda).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n%-----------------------------------------------------------------------%\n\nupdate_lambdas_this_stmt(Update, pre_statement(Type0, Info),\n pre_statement(Type, Info), !Acc) :-\n ( Type0 = s_call(Call0),\n update_lambdas_call(Update, Call0, Call, !Acc),\n Type = s_call(Call)\n ; Type0 = s_decl_vars(_),\n Type = Type0\n ; Type0 = s_assign(Var, Exprs0),\n map_foldl(update_lambdas_expr(Update), Exprs0, Exprs, !Acc),\n Type = s_assign(Var, Exprs)\n ; Type0 = s_return(_),\n Type = Type0\n ; Type0 = s_match(_, _),\n % We expect our caller to recurse into nested statements.\n Type = Type0\n ).\n\nupdate_lambdas_this_stmt_2(Update, pre_statement(Type0, Info),\n pre_statement(Type, Info), !Acc1, !Acc2) :-\n ( Type0 = s_call(Call0),\n update_lambdas_call_2(Update, Call0, Call, !Acc1, !Acc2),\n Type = s_call(Call)\n ; Type0 = s_decl_vars(_),\n Type = Type0\n ; Type0 = s_assign(Var, Exprs0),\n map_foldl2(update_lambdas_expr_2(Update), Exprs0, Exprs, !Acc1, !Acc2),\n Type = s_assign(Var, Exprs)\n ; Type0 = s_return(_),\n Type = Type0\n ; Type0 = s_match(_, _),\n % We expect our caller to recurse into nested statements.\n Type = Type0\n ).\n\n:- pred update_lambdas_call(pred(pre_lambda, pre_lambda, T, T),\n pre_call, pre_call, T, T).\n:- mode update_lambdas_call(pred(in, out, in, out) is det,\n in, out, in, out) is det.\n\nupdate_lambdas_call(Update, pre_call(Func, Args0, Bang),\n pre_call(Func, Args, Bang), !Acc) :-\n map_foldl(update_lambdas_expr(Update), Args0, Args, !Acc).\nupdate_lambdas_call(Update, pre_ho_call(Ho0, Args0, Bang),\n pre_ho_call(Ho, Args, Bang), !Acc) :-\n update_lambdas_expr(Update, Ho0, Ho, !Acc),\n map_foldl(update_lambdas_expr(Update), Args0, Args, !Acc).\n\n:- pred update_lambdas_call_2(pred(pre_lambda, pre_lambda, T, T, U, U),\n pre_call, pre_call, T, T, U, U).\n:- mode update_lambdas_call_2(pred(in, out, in, out, in, out) is det,\n in, out, in, out, in, out) is det.\n\nupdate_lambdas_call_2(Update, pre_call(Func, Args0, Bang),\n pre_call(Func, Args, Bang), !Acc1, !Acc2) :-\n map_foldl2(update_lambdas_expr_2(Update), Args0, Args, !Acc1, !Acc2).\nupdate_lambdas_call_2(Update, pre_ho_call(Ho0, Args0, Bang),\n pre_ho_call(Ho, Args, Bang), !Acc1, !Acc2) :-\n update_lambdas_expr_2(Update, Ho0, Ho, !Acc1, !Acc2),\n map_foldl2(update_lambdas_expr_2(Update), Args0, Args, !Acc1, !Acc2).\n\n:- pred update_lambdas_expr(pred(pre_lambda, pre_lambda, T, T),\n pre_expr, pre_expr, T, T).\n:- mode update_lambdas_expr(pred(in, out, in, out) is det,\n in, out, in, out) is det.\n\nupdate_lambdas_expr(Update, e_call(Call0), e_call(Call), !Acc) :-\n update_lambdas_call(Update, Call0, Call, !Acc).\nupdate_lambdas_expr(Update, e_match(Expr0, Cases0), e_match(Expr, Cases),\n !Acc) :-\n update_lambdas_expr(Update, Expr0, Expr, !Acc),\n map_foldl(update_lambdas_case(Update), Cases0, Cases, !Acc).\nupdate_lambdas_expr(_, e_var(Var), e_var(Var), !Acc).\nupdate_lambdas_expr(Update, e_construction(Ctors, Args0),\n e_construction(Ctors, Args), !Acc) :-\n map_foldl(update_lambdas_expr(Update), Args0, Args, !Acc).\nupdate_lambdas_expr(Update, e_lambda(Lambda0), e_lambda(Lambda), !Acc) :-\n Update(Lambda0, Lambda, !Acc).\nupdate_lambdas_expr(_, e_constant(Const), e_constant(Const), !Acc).\n\n:- pred update_lambdas_expr_2(pred(pre_lambda, pre_lambda, T, T, U, U),\n pre_expr, pre_expr, T, T, U, U).\n:- mode update_lambdas_expr_2(pred(in, out, in, out, in, out) is det,\n in, out, in, out, in, out) is det.\n\nupdate_lambdas_expr_2(Update, e_call(Call0), e_call(Call), !Acc1, !Acc2) :-\n update_lambdas_call_2(Update, Call0, Call, !Acc1, !Acc2).\nupdate_lambdas_expr_2(Update, e_match(Expr0, Cases0), e_match(Expr, Cases),\n !Acc1, !Acc2) :-\n update_lambdas_expr_2(Update, Expr0, Expr, !Acc1, !Acc2),\n map_foldl2(update_lambdas_case_2(Update), Cases0, Cases, !Acc1, !Acc2).\nupdate_lambdas_expr_2(_, e_var(Var), e_var(Var), !Acc1, !Acc2).\nupdate_lambdas_expr_2(Update, e_construction(Ctors, Args0),\n e_construction(Ctors, Args), !Acc1, !Acc2) :-\n map_foldl2(update_lambdas_expr_2(Update), Args0, Args, !Acc1, !Acc2).\nupdate_lambdas_expr_2(Update, e_lambda(Lambda0), e_lambda(Lambda),\n !Acc1, !Acc2) :-\n Update(Lambda0, Lambda, !Acc1, !Acc2).\nupdate_lambdas_expr_2(_, e_constant(Const), e_constant(Const), !Acc1, !Acc2).\n\n:- pred update_lambdas_case(pred(pre_lambda, pre_lambda, T, T),\n pre_expr_case, pre_expr_case, T, T).\n:- mode update_lambdas_case(pred(in, out, in, out) is det,\n in, out, in, out) is det.\n\nupdate_lambdas_case(Update, pre_e_case(Pat, Expr0), pre_e_case(Pat, Expr),\n !Acc) :-\n map_foldl(update_lambdas_expr(Update), Expr0, Expr, !Acc).\n\n:- pred update_lambdas_case_2(pred(pre_lambda, pre_lambda, T, T, U, U),\n pre_expr_case, pre_expr_case, T, T, U, U).\n:- mode update_lambdas_case_2(pred(in, out, in, out, in, out) is det,\n in, out, in, out, in, out) is det.\n\nupdate_lambdas_case_2(Update, pre_e_case(Pat, Expr0), pre_e_case(Pat, Expr),\n !Acc1, !Acc2) :-\n map_foldl2(update_lambdas_expr_2(Update), Expr0, Expr, !Acc1, !Acc2).\n\n%-----------------------------------------------------------------------%\n\nget_all_lambdas_stmts(Stmts) = condense(map(get_all_lambdas_stmt, Stmts)).\n\n:- func get_all_lambdas_stmt(pre_statement) = list(pre_lambda).\n\nget_all_lambdas_stmt(pre_statement(Type, _)) = Lambdas :-\n ( Type = s_call(Call),\n Lambdas = get_all_lambdas_call(Call)\n ; Type = s_decl_vars(_),\n Lambdas = []\n ; Type = s_assign(_, Exprs),\n Lambdas = condense(map(get_all_lambdas_expr, Exprs))\n ; Type = s_return(_),\n Lambdas = []\n ; Type = s_match(_, Cases),\n Lambdas = condense(map(get_all_lambdas_case, Cases))\n ).\n\n:- func get_all_lambdas_call(pre_call) = list(pre_lambda).\n\nget_all_lambdas_call(Call) = condense(map(get_all_lambdas_expr, Args)) :-\n ( Call = pre_call(_, Args, _)\n ; Call = pre_ho_call(_, Args, _)\n ).\n\n:- func get_all_lambdas_expr(pre_expr) = list(pre_lambda).\n\nget_all_lambdas_expr(Expr) = Lambdas :-\n ( Expr = e_call(Call),\n Lambdas = get_all_lambdas_call(Call)\n ; Expr = e_match(MatchExpr, Cases),\n Lambdas = get_all_lambdas_expr(MatchExpr) ++ condense(map(\n func(pre_e_case(_, Es)) =\n condense(map(get_all_lambdas_expr, Es)),\n Cases))\n ;\n ( Expr = e_var(_)\n ; Expr = e_constant(_)\n ),\n Lambdas = []\n ; Expr = e_construction(_, Args),\n Lambdas = condense(map(get_all_lambdas_expr, Args))\n ; Expr = e_lambda(Lambda),\n Lambdas = [Lambda]\n ).\n\n:- func get_all_lambdas_case(pre_case) = list(pre_lambda).\n\nget_all_lambdas_case(pre_case(_, Stmts)) = get_all_lambdas_stmts(Stmts).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pz.bytecode.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pz.bytecode.\n%\n% Common code for reading or writing PZ bytecode.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module maybe.\n\n:- import_module common_types.\n:- import_module pz.code.\n\n%-----------------------------------------------------------------------%\n\n:- type code_entry_type\n ---> code_instr\n ; code_meta_context\n ; code_meta_context_short\n ; code_meta_context_nil.\n\n:- inst code_entry_type_context for code_entry_type/0\n ---> code_meta_context\n ; code_meta_context_short\n ; code_meta_context_nil.\n\n%-----------------------------------------------------------------------%\n% Instruction encoding\n%-----------------------------------------------------------------------%\n\n:- type pz_opcode\n ---> pzo_load_immediate_num\n ; pzo_ze\n ; pzo_se\n ; pzo_trunc\n ; pzo_add\n ; pzo_sub\n ; pzo_mul\n ; pzo_div\n ; pzo_mod\n ; pzo_lshift\n ; pzo_rshift\n ; pzo_and\n ; pzo_or\n ; pzo_xor\n ; pzo_lt_u\n ; pzo_lt_s\n ; pzo_gt_u\n ; pzo_gt_s\n ; pzo_eq\n ; pzo_not\n ; pzo_drop\n ; pzo_roll\n ; pzo_pick\n ; pzo_call\n ; pzo_call_import\n ; pzo_call_ind\n ; pzo_call_proc\n ; pzo_tcall\n ; pzo_tcall_import\n ; pzo_tcall_ind\n ; pzo_tcall_proc\n ; pzo_cjmp\n ; pzo_jmp\n ; pzo_ret\n ; pzo_alloc\n ; pzo_make_closure\n ; pzo_load\n ; pzo_store\n ; pzo_get_env.\n\n:- type maybe_operand_width\n ---> one_width(pz_width)\n ; two_widths(pz_width, pz_width)\n ; no_width.\n\n:- pred instruction(pz_instr, pz_opcode, maybe_operand_width,\n maybe(pz_immediate_value)).\n:- mode instruction(in, out, out, out) is det.\n:- mode instruction(out, in, in, in) is semidet.\n\n:- type num_needed_widths\n ---> one_width\n ; two_widths\n ; no_width.\n\n % This type represents intermediate values within the instruction\n % stream, such as labels and stack depths. The related immediate_value\n % type, represents only the types of immediate values that can be loaded\n % with the pzi_load_immediate instruction.\n %\n:- type immediate_needed\n ---> im_none\n ; im_num\n ; im_closure\n ; im_proc\n ; im_import\n ; im_struct\n ; im_struct_field\n ; im_label\n ; im_depth. % A stack depth\n\n% Instruction encoding information.\n\n:- pred instruction_encoding(pz_opcode, num_needed_widths, immediate_needed).\n:- mode instruction_encoding(in, out, out) is det.\n\n%-----------------------------------------------------------------------%\n\n % This type represents intermediate values within the instruction\n % stream, such as labels and stack depths. The related immediate_value\n % type, represents only the types of immediate values that can be loaded\n % with the pzi_load_immediate instruction.\n %\n:- type pz_immediate_value\n ---> pz_im_i8(int8)\n ; pz_im_u8(uint8)\n ; pz_im_i16(int16)\n ; pz_im_u16(uint16)\n ; pz_im_i32(int32)\n ; pz_im_u32(uint32)\n ; pz_im_i64(int64)\n ; pz_im_u64(uint64)\n ; pz_im_closure(pzc_id)\n ; pz_im_proc(pzp_id)\n ; pz_im_import(pzi_id)\n ; pz_im_struct(pzs_id)\n ; pz_im_struct_field(pzs_id, field_num)\n ; pz_im_label(pzb_id)\n ; pz_im_depth(int). % A stack depth\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module list.\n\n:- pragma foreign_decl(\"C\", include_file(\"../runtime/pz_common.h\")).\n:- pragma foreign_decl(\"C\", include_file(\"../runtime/pz_instructions.h\")).\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_enum(\"C\", code_entry_type/0, [\n code_instr - \"PZ_CODE_INSTR\",\n code_meta_context - \"PZ_CODE_META_CONTEXT\",\n code_meta_context_short - \"PZ_CODE_META_CONTEXT_SHORT\",\n code_meta_context_nil - \"PZ_CODE_META_CONTEXT_NIL\"\n]).\n\n%-----------------------------------------------------------------------%\n% Instruction encoding\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_enum(\"C\", pz_opcode/0, [\n pzo_load_immediate_num - \"PZI_LOAD_IMMEDIATE_NUM\",\n pzo_ze - \"PZI_ZE\",\n pzo_se - \"PZI_SE\",\n pzo_trunc - \"PZI_TRUNC\",\n pzo_add - \"PZI_ADD\",\n pzo_sub - \"PZI_SUB\",\n pzo_mul - \"PZI_MUL\",\n pzo_div - \"PZI_DIV\",\n pzo_mod - \"PZI_MOD\",\n pzo_lshift - \"PZI_LSHIFT\",\n pzo_rshift - \"PZI_RSHIFT\",\n pzo_and - \"PZI_AND\",\n pzo_or - \"PZI_OR\",\n pzo_xor - \"PZI_XOR\",\n pzo_lt_u - \"PZI_LT_U\",\n pzo_lt_s - \"PZI_LT_S\",\n pzo_gt_u - \"PZI_GT_U\",\n pzo_gt_s - \"PZI_GT_S\",\n pzo_eq - \"PZI_EQ\",\n pzo_not - \"PZI_NOT\",\n pzo_drop - \"PZI_DROP\",\n pzo_roll - \"PZI_ROLL\",\n pzo_pick - \"PZI_PICK\",\n pzo_call - \"PZI_CALL\",\n pzo_call_import - \"PZI_CALL_IMPORT\",\n pzo_call_ind - \"PZI_CALL_IND\",\n pzo_call_proc - \"PZI_CALL_PROC\",\n pzo_tcall - \"PZI_TCALL\",\n pzo_tcall_import - \"PZI_TCALL_IMPORT\",\n pzo_tcall_ind - \"PZI_TCALL_IND\",\n pzo_tcall_proc - \"PZI_TCALL_PROC\",\n pzo_cjmp - \"PZI_CJMP\",\n pzo_jmp - \"PZI_JMP\",\n pzo_ret - \"PZI_RET\",\n pzo_alloc - \"PZI_ALLOC\",\n pzo_make_closure - \"PZI_MAKE_CLOSURE\",\n pzo_load - \"PZI_LOAD\",\n pzo_store - \"PZI_STORE\",\n pzo_get_env - \"PZI_GET_ENV\"\n]).\n\ninstruction(pzi_load_immediate(W, NI), pzo_load_immediate_num, one_width(W),\n yes(I)) :-\n immediate_num(NI, I).\ninstruction(pzi_ze(W1, W2), pzo_ze, two_widths(W1, W2),\n no).\ninstruction(pzi_se(W1, W2), pzo_se, two_widths(W1, W2),\n no).\ninstruction(pzi_trunc(W1, W2), pzo_trunc, two_widths(W1, W2),\n no).\ninstruction(pzi_add(W), pzo_add, one_width(W),\n no).\ninstruction(pzi_sub(W), pzo_sub, one_width(W),\n no).\ninstruction(pzi_mul(W), pzo_mul, one_width(W),\n no).\ninstruction(pzi_div(W), pzo_div, one_width(W),\n no).\ninstruction(pzi_mod(W), pzo_mod, one_width(W),\n no).\ninstruction(pzi_lshift(W), pzo_lshift, one_width(W),\n no).\ninstruction(pzi_rshift(W), pzo_rshift, one_width(W),\n no).\ninstruction(pzi_and(W), pzo_and, one_width(W),\n no).\ninstruction(pzi_or(W), pzo_or, one_width(W),\n no).\ninstruction(pzi_xor(W), pzo_xor, one_width(W),\n no).\ninstruction(pzi_lt_u(W), pzo_lt_u, one_width(W),\n no).\ninstruction(pzi_lt_s(W), pzo_lt_s, one_width(W),\n no).\ninstruction(pzi_gt_u(W), pzo_gt_u, one_width(W),\n no).\ninstruction(pzi_gt_s(W), pzo_gt_s, one_width(W),\n no).\ninstruction(pzi_eq(W), pzo_eq, one_width(W),\n no).\ninstruction(pzi_not(W), pzo_not, one_width(W),\n no).\ninstruction(pzi_drop, pzo_drop, no_width,\n no).\ninstruction(pzi_roll(D), pzo_roll, no_width,\n yes(pz_im_depth(D))).\ninstruction(pzi_pick(D), pzo_pick, no_width,\n yes(pz_im_depth(D))).\ninstruction(pzi_call(pzc_closure(C)), pzo_call, no_width,\n yes(pz_im_closure(C))).\ninstruction(pzi_call(pzc_import(I)), pzo_call_import, no_width,\n yes(pz_im_import(I))).\ninstruction(pzi_call(pzc_proc_opt(P)), pzo_call_proc, no_width,\n yes(pz_im_proc(P))).\ninstruction(pzi_call_ind, pzo_call_ind, no_width,\n no).\ninstruction(pzi_tcall(pzc_closure(C)), pzo_tcall, no_width,\n yes(pz_im_closure(C))).\ninstruction(pzi_tcall(pzc_import(I)), pzo_tcall_import, no_width,\n yes(pz_im_import(I))).\ninstruction(pzi_tcall(pzc_proc_opt(P)), pzo_tcall_proc, no_width,\n yes(pz_im_proc(P))).\ninstruction(pzi_tcall_ind, pzo_tcall_ind, no_width,\n no).\ninstruction(pzi_cjmp(L, W), pzo_cjmp, one_width(W),\n yes(pz_im_label(L))).\ninstruction(pzi_jmp(L), pzo_jmp, no_width,\n yes(pz_im_label(L))).\ninstruction(pzi_ret, pzo_ret, no_width,\n no).\ninstruction(pzi_alloc(S), pzo_alloc, no_width,\n yes(pz_im_struct(S))).\ninstruction(pzi_make_closure(P), pzo_make_closure, no_width,\n yes(pz_im_proc(P))).\ninstruction(pzi_load(S, F, W), pzo_load, one_width(W),\n yes(pz_im_struct_field(S, F))).\ninstruction(pzi_store(S, F, W), pzo_store, one_width(W),\n yes(pz_im_struct_field(S, F))).\ninstruction(pzi_get_env, pzo_get_env, no_width,\n no).\n\n:- pred immediate_num(immediate_value, pz_immediate_value).\n:- mode immediate_num(in, out) is det.\n:- mode immediate_num(out, in) is semidet.\n\nimmediate_num(im_i8(N), pz_im_i8(N)).\nimmediate_num(im_u8(N), pz_im_u8(N)).\nimmediate_num(im_i16(N), pz_im_i16(N)).\nimmediate_num(im_u16(N), pz_im_u16(N)).\nimmediate_num(im_i32(N), pz_im_i32(N)).\nimmediate_num(im_u32(N), pz_im_u32(N)).\nimmediate_num(im_i64(N), pz_im_i64(N)).\nimmediate_num(im_u64(N), pz_im_u64(N)).\n\ninstruction_encoding(pzo_load_immediate_num, one_width, im_num).\ninstruction_encoding(pzo_ze, two_widths, im_none).\ninstruction_encoding(pzo_se, two_widths, im_none).\ninstruction_encoding(pzo_trunc, two_widths, im_none).\ninstruction_encoding(pzo_add, one_width, im_none).\ninstruction_encoding(pzo_sub, one_width, im_none).\ninstruction_encoding(pzo_mul, one_width, im_none).\ninstruction_encoding(pzo_div, one_width, im_none).\ninstruction_encoding(pzo_mod, one_width, im_none).\ninstruction_encoding(pzo_lshift, one_width, im_none).\ninstruction_encoding(pzo_rshift, one_width, im_none).\ninstruction_encoding(pzo_and, one_width, im_none).\ninstruction_encoding(pzo_or, one_width, im_none).\ninstruction_encoding(pzo_xor, one_width, im_none).\ninstruction_encoding(pzo_lt_u, one_width, im_none).\ninstruction_encoding(pzo_lt_s, one_width, im_none).\ninstruction_encoding(pzo_gt_u, one_width, im_none).\ninstruction_encoding(pzo_gt_s, one_width, im_none).\ninstruction_encoding(pzo_eq, one_width, im_none).\ninstruction_encoding(pzo_not, one_width, im_none).\ninstruction_encoding(pzo_drop, no_width, im_none).\ninstruction_encoding(pzo_roll, no_width, im_depth).\ninstruction_encoding(pzo_pick, no_width, im_depth).\ninstruction_encoding(pzo_call, no_width, im_closure).\ninstruction_encoding(pzo_call_import, no_width, im_import).\ninstruction_encoding(pzo_call_proc, no_width, im_proc).\ninstruction_encoding(pzo_call_ind, no_width, im_none).\ninstruction_encoding(pzo_tcall, no_width, im_closure).\ninstruction_encoding(pzo_tcall_import, no_width, im_import).\ninstruction_encoding(pzo_tcall_proc, no_width, im_proc).\ninstruction_encoding(pzo_tcall_ind, no_width, im_none).\ninstruction_encoding(pzo_cjmp, one_width, im_label).\ninstruction_encoding(pzo_jmp, no_width, im_label).\ninstruction_encoding(pzo_ret, no_width, im_none).\ninstruction_encoding(pzo_alloc, no_width, im_struct).\ninstruction_encoding(pzo_make_closure, no_width, im_proc).\ninstruction_encoding(pzo_load, one_width, im_struct_field).\ninstruction_encoding(pzo_store, one_width, im_struct_field).\ninstruction_encoding(pzo_get_env, no_width, im_none).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pz.code.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pz.code.\n%\n% PZ representation of code.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module list.\n\n:- import_module common_types.\n:- import_module context.\n:- import_module maybe.\n:- import_module q_name.\n\n:- type pz_proc\n ---> pz_proc(\n pzp_name :: q_name,\n pzp_signature :: pz_signature,\n\n % Procedures imported from other modules will not have a\n % body.\n pzp_blocks :: maybe(list(pz_block))\n ).\n\n % A procedure's signature describes how it behaves with respect to the\n % parameter stack.\n %\n % ( before - after )\n %\n % before is the list of items (left = lower) on the stack before the\n % call, after is the list of items (left = lower) on the stack after the\n % call. Of course other things may be on the stack, but this call\n % promises no to affect them.\n %\n % When functions are translated to procedures, parameters are pushed\n % onto the stack in the order they appear - leftmost parameters are\n % deeper on the stack, this is the same for return parameters.\n %\n % The bytecode interpreter/code generator isn't required to check this,\n % but it may use this information to generate code - so it must be\n % correct.\n %\n % XXX: varargs\n %\n:- type pz_signature\n ---> pz_signature(\n pzs_before :: list(pz_width),\n pzs_after :: list(pz_width)\n ).\n\n:- type pz_block\n ---> pz_block(\n pzb_instrs :: list(pz_instr_obj)\n ).\n\n % An instruction object. Is anything that can appear within an\n % instruction stream including a comment.\n %\n:- type pz_instr_obj\n ---> pzio_instr(\n pzio_instr :: pz_instr\n )\n ; pzio_context(\n pzio_context :: pz_context\n )\n ; pzio_comment(\n pzio_comment :: string\n ).\n\n:- type pz_instr\n ---> pzi_load_immediate(pz_width, immediate_value)\n ; pzi_ze(pz_width, pz_width)\n ; pzi_se(pz_width, pz_width)\n ; pzi_trunc(pz_width, pz_width)\n ; pzi_add(pz_width)\n ; pzi_sub(pz_width)\n ; pzi_mul(pz_width)\n ; pzi_div(pz_width)\n ; pzi_mod(pz_width)\n ; pzi_lshift(pz_width)\n ; pzi_rshift(pz_width)\n ; pzi_and(pz_width)\n ; pzi_or(pz_width)\n ; pzi_xor(pz_width)\n ; pzi_lt_u(pz_width)\n ; pzi_lt_s(pz_width)\n ; pzi_gt_u(pz_width)\n ; pzi_gt_s(pz_width)\n ; pzi_eq(pz_width)\n ; pzi_not(pz_width)\n ; pzi_drop\n\n % Roll the top N items on the stack shifting them toward the\n % left, the deepest item becomes the TOS and all\n % other items shift along one space deeper (to the left).\n % roll 1 is a no-op, roll 2 is \"swap\".\n ; pzi_roll(int)\n ; pzi_pick(int)\n ; pzi_call(pz_callee)\n ; pzi_tcall(pz_callee)\n ; pzi_call_ind\n ; pzi_tcall_ind\n ; pzi_cjmp(pzb_id, pz_width)\n ; pzi_jmp(pzb_id)\n ; pzi_ret\n\n ; pzi_alloc(pzs_id)\n ; pzi_make_closure(pzp_id)\n ; pzi_load(pzs_id, field_num, pz_width)\n ; pzi_store(pzs_id, field_num, pz_width)\n ; pzi_get_env.\n\n:- type pz_callee\n ---> pzc_closure(pzc_id)\n ; pzc_import(pzi_id)\n % Being able to refer to a proc directly is an optimisation.\n ; pzc_proc_opt(pzp_id).\n\n % This type represents the kinds of immediate value that can be loaded\n % onto the stack via the pzi_load_immediate instruction. The related\n % type pz_immediate_value is more comprehensive and covers intermediate\n % values within the instruction stream, such as labels and stack depths.\n %\n:- type immediate_value\n ---> im_i8(int8)\n ; im_u8(uint8)\n ; im_i16(int16)\n ; im_u16(uint16)\n ; im_i32(int32)\n ; im_u32(uint32)\n ; im_i64(int64)\n ; im_u64(uint64).\n\n:- type pz_context\n ---> pz_context(\n pzic_context :: context,\n pzic_file_data :: pzd_id\n )\n ; pz_context_short(\n pzics_line :: int\n )\n ; pz_nil_context.\n\n % Block ID\n %\n:- type pzb_id == uint32.\n\n%\n% Some aliases for commonly used instructions.\n%\n\n:- func pzi_dup = pz_instr.\n\n:- func pzi_swap = pz_instr.\n\n%-----------------------------------------------------------------------%\n\n:- type pz_entry_signature\n ---> pz_es_plain\n ; pz_es_args.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n%-----------------------------------------------------------------------%\n\npzi_dup = pzi_pick(1).\n\npzi_swap = pzi_roll(2).\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_enum(\"C\", pz_entry_signature/0,\n [ pz_es_plain - \"PZ_OPT_ENTRY_SIG_PLAIN\",\n pz_es_args - \"PZ_OPT_ENTRY_SIG_ARGS\"\n ]).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pz.format.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pz.format.\n%\n% Common code for the PZ file format.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module pz.bytecode.\n:- import_module pz.code.\n\n%-----------------------------------------------------------------------%\n\n:- func pz_object_magic = uint32.\n\n:- func pz_program_magic = uint32.\n\n:- func pz_library_magic = uint32.\n\n:- func pz_object_id_string = string.\n:- func pz_object_id_string_part = string.\n\n:- func pz_program_id_string = string.\n:- func pz_program_id_string_part = string.\n\n:- func pz_library_id_string = string.\n:- func pz_library_id_string_part = string.\n\n:- func pz_version = uint16.\n\n%-----------------------------------------------------------------------%\n\n% Constants for encoding option types.\n\n:- func pzf_opt_entry_closure = uint16.\n:- func pzf_opt_entry_candidate = uint16.\n\n:- pred pz_signature_byte(pz_entry_signature, uint8).\n:- mode pz_signature_byte(in, out) is det.\n:- mode pz_signature_byte(out, in) is semidet.\n\n%-----------------------------------------------------------------------%\n\n% Constants for encoding data types.\n\n:- func pzf_data_array = uint8.\n:- func pzf_data_struct = uint8.\n:- func pzf_data_string = uint8.\n\n % Encoding type is used for data items, it is used by the code that\n % reads/writes this static data so that it knows how to interpret each\n % value.\n %\n:- type enc_type\n ---> t_normal\n ; t_wfast\n ; t_wptr\n ; t_data\n ; t_import\n ; t_closure.\n\n:- pred pz_enc_byte(enc_type, int, uint8).\n:- mode pz_enc_byte(in, in, out) is det.\n:- mode pz_enc_byte(out, out, in) is semidet.\n\n%-----------------------------------------------------------------------%\n\n:- pred code_entry_byte(code_entry_type, uint8).\n:- mode code_entry_byte(in, out) is det.\n:- mode code_entry_byte(out, in) is semidet.\n\n%-----------------------------------------------------------------------%\n\n:- pred opcode_byte(pz_opcode, uint8).\n:- mode opcode_byte(in, out) is det.\n:- mode opcode_byte(out, in) is semidet.\n\n:- pred pz_width_byte(pz_width, uint8).\n:- mode pz_width_byte(in, out) is det.\n:- mode pz_width_byte(out, in) is semidet.\n\n%-----------------------------------------------------------------------%\n\n:- pred pz_import_type_byte(pz_import_type, uint8).\n:- mode pz_import_type_byte(in, out) is det.\n:- mode pz_import_type_byte(out, in) is semidet.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module uint16.\n\n:- pragma foreign_decl(\"C\", include_file(\"../runtime/pz_common.h\")).\n:- pragma foreign_decl(\"C\", include_file(\"../runtime/pz_format.h\")).\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_proc(\"C\",\n pz_object_magic = (Magic::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"\n Magic = PZ_OBJECT_MAGIC_NUMBER;\n \").\n\n:- pragma foreign_proc(\"C\",\n pz_program_magic = (Magic::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"\n Magic = PZ_PROGRAM_MAGIC_NUMBER;\n \").\n\n:- pragma foreign_proc(\"C\",\n pz_library_magic = (Magic::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"\n Magic = PZ_LIBRARY_MAGIC_NUMBER;\n \").\n\n%-----------------------------------------------------------------------%\n\npz_object_id_string = make_id_string(pz_object_id_string_part).\n\n:- pragma foreign_proc(\"C\",\n pz_object_id_string_part = (X::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"\n /*\n * Cast away the const qualifier, Mercury won't modify this string\n * because it does not have a unique mode.\n */\n X = (char*)PZ_OBJECT_MAGIC_STRING;\n \").\n\npz_program_id_string = make_id_string(pz_program_id_string_part).\n\n:- pragma foreign_proc(\"C\",\n pz_program_id_string_part = (X::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"\n /*\n * Cast away the const qualifier, Mercury won't modify this string\n * because it does not have a unique mode.\n */\n X = (char*)PZ_PROGRAM_MAGIC_STRING;\n \").\n\npz_library_id_string = make_id_string(pz_library_id_string_part).\n\n:- pragma foreign_proc(\"C\",\n pz_library_id_string_part = (X::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"\n /*\n * Cast away the const qualifier, Mercury won't modify this string\n * because it does not have a unique mode.\n */\n X = (char*)PZ_LIBRARY_MAGIC_STRING;\n \").\n\n:- func make_id_string(string) = string.\n\nmake_id_string(Part) =\n format(\"%s version %d\", [s(Part), i(to_int(pz_version))]).\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_proc(\"C\",\n pz_version = (X::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"X = PZ_FORMAT_VERSION;\").\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_proc(\"C\",\n pz_signature_byte(Val::in, Byte::out),\n [promise_pure, thread_safe, will_not_call_mercury,\n will_not_throw_exception],\n \"\n Byte = Val;\n \").\n\n:- pragma foreign_proc(\"C\",\n pz_signature_byte(Val::out, Byte::in),\n [promise_pure, thread_safe, will_not_call_mercury,\n will_not_throw_exception],\n \"\n SUCCESS_INDICATOR = Byte <= PZ_OPT_ENTRY_SIG_LAST;\n Val = Byte;\n \").\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_proc(\"C\",\n pzf_opt_entry_closure = (X::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"X = PZ_OPT_ENTRY_CLOSURE;\").\n\n:- pragma foreign_proc(\"C\",\n pzf_opt_entry_candidate = (X::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"X = PZ_OPT_ENTRY_CANDIDATE;\").\n\n%-----------------------------------------------------------------------%\n\n% These are used directly as integers when writing out PZ files,\n% otherwise this would be a good candidate for a foreign_enum.\n\n:- pragma foreign_proc(\"C\",\n pzf_data_array = (X::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"X = PZ_DATA_ARRAY;\").\n:- pragma foreign_proc(\"C\",\n pzf_data_struct = (X::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"X = PZ_DATA_STRUCT;\").\n:- pragma foreign_proc(\"C\",\n pzf_data_string = (X::out),\n [will_not_call_mercury, thread_safe, promise_pure],\n \"X = PZ_DATA_STRING;\").\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_enum(\"C\", enc_type/0,\n [ t_normal - \"pz_data_enc_type_normal\",\n t_wfast - \"pz_data_enc_type_fast\",\n t_wptr - \"pz_data_enc_type_wptr\",\n t_data - \"pz_data_enc_type_data\",\n t_import - \"pz_data_enc_type_import\",\n t_closure - \"pz_data_enc_type_closure\"\n ]).\n\n:- pragma foreign_proc(\"C\",\n pz_enc_byte(EncType::in, NumBytes::in, EncInt::out),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"\n EncInt = PZ_MAKE_ENC(EncType, NumBytes);\n \").\n\n:- pragma foreign_proc(\"C\",\n pz_enc_byte(EncType::out, NumBytes::out, EncInt::in),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"\n EncType = PZ_DATA_ENC_TYPE(EncInt);\n NumBytes = PZ_DATA_ENC_BYTES(EncInt);\n SUCCESS_INDICATOR = EncType <= PZ_LAST_DATA_ENC_TYPE;\n \").\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_proc(\"C\",\n code_entry_byte(CodeEntry::in, Byte::out),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"Byte = CodeEntry\").\n\n:- pragma foreign_proc(\"C\",\n code_entry_byte(CodeEntry::out, Byte::in),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"\n CodeEntry = Byte;\n SUCCESS_INDICATOR = CodeEntry < PZ_NUM_CODE_ITEMS;\n \").\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_proc(\"C\",\n opcode_byte(OpcodeValue::in, Byte::out),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"Byte = OpcodeValue\").\n\n:- pragma foreign_proc(\"C\",\n opcode_byte(OpcodeValue::out, Byte::in),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"\n OpcodeValue = Byte;\n SUCCESS_INDICATOR = Byte < PZ_NUM_OPCODES;\n \").\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_proc(\"C\",\n pz_width_byte(WidthValue::in, Byte::out),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"Byte = WidthValue;\").\n\n:- pragma foreign_proc(\"C\",\n pz_width_byte(WidthValue::out, Byte::in),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"\n WidthValue = Byte;\n SUCCESS_INDICATOR = Byte < PZ_NUM_WIDTHS;\n \").\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_proc(\"C\",\n pz_import_type_byte(ImportType::in, Byte::out),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"Byte = ImportType;\").\n\n:- pragma foreign_proc(\"C\",\n pz_import_type_byte(ImportType::out, Byte::in),\n [will_not_call_mercury, promise_pure, thread_safe],\n \"\n ImportType = Byte;\n SUCCESS_INDICATOR = Byte <= PZ_IMPORT_LAST;\n \").\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pz.link.m", "content": "%-----------------------------------------------------------------------%\n% Plasma linking code\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This program links the pz intermediate representation.\n%\n%-----------------------------------------------------------------------%\n:- module pz.link.\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module maybe.\n\n:- import_module q_name.\n:- import_module util.\n:- import_module util.result.\n\n:- type link_error == string.\n\n:- type pzo_link_kind\n ---> pz_program(\n pzlkp_entry_point :: maybe(q_name),\n pzlkp_name :: nq_name\n )\n ; pz_library(\n pzlkp_export_mods :: list(nq_name)\n ).\n\n:- pred do_link(pzo_link_kind::in, list(pz)::in,\n result(pz, link_error)::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module array.\n:- import_module assoc_list.\n:- import_module cord.\n:- import_module int.\n:- import_module map.\n:- import_module pair.\n:- import_module require.\n:- import_module set.\n:- import_module uint32.\n\n:- import_module context.\n:- import_module pz.code.\n:- import_module pz.bytecode.\n:- import_module pz.pz_ds.\n:- import_module util.my_exception.\n:- import_module util.mercury.\n\n%-----------------------------------------------------------------------%\n\ndo_link(LinkKind, Inputs, Result) :-\n some [!PZ, !Errors] (\n !:Errors = init,\n\n ( LinkKind = pz_program(_, Name),\n FileType = pzft_program,\n Names = [Name]\n ; LinkKind = pz_library(Names),\n FileType = pzft_library\n ),\n\n % Calculate the IDs of all the entries in the new PZ file. Also\n % build a map from module names to modules and count the various\n % entries.\n build_input_maps(Inputs, IdMap, ModNameMap, NumStructs, NumDatas,\n NumProcs, NumClosures),\n\n !:PZ = init_pz(map(q_name, Names), FileType, 0u32, NumStructs,\n NumDatas, NumProcs, NumClosures),\n\n % Build a map of exports. This will be used to determine what can be\n % linked too.\n foldl2(build_export_map(!.PZ, IdMap), Inputs, 0, _, init, ExportMap),\n\n % Link the files by each entry type at a time, eg: all the structs for\n % all the inputs, then all the datas for all the inputs.\n\n foldl2(link_structs(IdMap), Inputs, 0, _, !PZ),\n % Process imports, those found in ExportMap will be linked and the\n % others will become imports in !PZ.\n foldl3(link_imports(ExportMap), Inputs, 0, _, !PZ, init, CloLinkMap),\n foldl2(link_datas(IdMap, CloLinkMap), Inputs, 0, _, !PZ),\n foldl2(link_procs(IdMap, CloLinkMap), Inputs, 0, _, !PZ),\n foldl2(link_closures(IdMap), Inputs, 0, _, !PZ),\n\n % Entrypoints and exports don't need to be polarised for programs\n % and libraries like this. It'd be possible to have libraries with\n % entrypoints or programs with exports. But for now we keep things\n % simple until we work on the tooling.\n ( LinkKind = pz_program(MaybeEntry, _),\n link_set_entrypoints(IdMap, ModNameMap, Inputs, MaybeEntry,\n !PZ, !Errors)\n ; LinkKind = pz_library(_),\n foldl2((pred(N::in, PZ0::in, PZ::out, Es0::in, Es::out) is det :-\n link_set_exports(N, IdMap, ModNameMap,\n PZ0, PZ, Es0, Es)\n ), Names, !PZ, !Errors)\n ),\n\n ( if is_empty(!.Errors) then\n Result = ok(!.PZ)\n else\n Result = errors(!.Errors)\n )\n ).\n\n:- pred link_set_entrypoints(id_map::in, map(q_name, {int, pz})::in,\n list(pz)::in, maybe(q_name)::in, pz::in, pz::out,\n errors(link_error)::in, errors(link_error)::out) is det.\n\nlink_set_entrypoints(IdMap, ModNameMap, Inputs, MaybeEntry, !PZ, !Errors) :-\n map_foldl(get_translate_entrypoints(!.PZ, IdMap),\n Inputs, AllEntrypoints, 0, _),\n MaybeEntryRes = find_entrypoint(!.PZ, IdMap, Inputs, ModNameMap,\n MaybeEntry),\n ( MaybeEntryRes = ok(no)\n ; MaybeEntryRes = ok(yes(Entry)),\n pz_entrypoint(Clo, Sig, EntryName) = Entry,\n pz_export_closure(Clo, EntryName, !PZ),\n pz_set_entry_closure(Clo, Sig, !PZ),\n ( if\n list.delete_first(condense(AllEntrypoints), Entry,\n CandidateEntrypoints)\n then\n foldl(add_entry_candidate, CandidateEntrypoints, !PZ)\n else\n unexpected($file, $pred,\n \"Entrypoint not in all entrypoints\")\n )\n ; MaybeEntryRes = errors(Errors),\n add_errors(Errors, !Errors)\n ).\n\n:- pred link_set_exports(nq_name::in, id_map::in, map(q_name, {int, pz})::in,\n pz::in, pz::out, errors(link_error)::in, errors(link_error)::out) is det.\n\nlink_set_exports(Name, IdMap, ModNameMap, !PZ, !Errors) :-\n % If a module has the same name as the library we're building,\n % then re-export all its exports.\n ( if search(ModNameMap, q_name(Name), {ModNum, Mod}) then\n Exports = pz_get_exports(Mod),\n foldl((pred((N - Cid0)::in, PZ0::in, PZ::out) is det :-\n Cid = transform_closure_id(PZ0, IdMap, ModNum, Cid0),\n pz_export_closure(Cid, N, PZ0, PZ)\n ), Exports, !PZ)\n else\n add_error(command_line_context,\n format(\"Module '%s' isn't being linked, can't export anything\",\n [s(nq_name_to_string(Name))]),\n !Errors)\n ).\n\n:- pred add_entry_candidate(pz_entrypoint::in, pz::in, pz::out) is det.\n\nadd_entry_candidate(pz_entrypoint(Clo, Sig, Name), !PZ) :-\n pz_export_closure(Clo, Name, !PZ),\n pz_add_entry_candidate(Clo, Sig, !PZ).\n\n%-----------------------------------------------------------------------%\n\n:- pred build_export_map(pz::in, id_map::in,\n pz::in, int::in, int::out, export_map::in, export_map::out) is det.\n\nbuild_export_map(PZ, IdMap, Input, InputNum, InputNum+1, !Exports) :-\n Exports = from_assoc_list(map((func(Name - Id0) = Name - Id :-\n Id = transform_closure_id(PZ, IdMap, InputNum, Id0)\n ), pz_get_exports(Input))),\n ( if [ModuleName] = pz_get_module_names(Input) then\n det_insert(ModuleName, Exports, !Exports)\n else\n util.my_exception.sorry($file, $pred, \"Multiple module names\")\n ).\n\n:- pred link_imports(export_map::in, pz::in, int::in, int::out,\n pz::in, pz::out, link_map::in, link_map::out) is det.\n\nlink_imports(ModuleMap, Input, InputNum, InputNum+1, !PZ, !LinkMap) :-\n Imports = pz_get_imports(Input),\n foldl2(link_imports_2(ModuleMap, InputNum), Imports, !PZ, !LinkMap).\n\n:- pred link_imports_2(export_map::in, int::in,\n pair(pzi_id, pz_import)::in, pz::in, pz::out,\n link_map::in, link_map::out) is det.\n\nlink_imports_2(ExportMap0, InputNum, ImportId - Import, !PZ, !LinkMap) :-\n Import = pz_import(Name, ImportType),\n ( ImportType = pzit_import,\n ( if\n q_name_parts(Name, yes(Module), _),\n search(ExportMap0, Module, ExportMap),\n ( if search(ExportMap, Name, ClosureId0) then\n ClosureId = ClosureId0\n else\n % This could almost be a compilation error, it shouldn't be\n % possible though but we could reconsider it.\n unexpected($file, $pred,\n format(\"Unknown symbol `%s`\\n\", [s(q_name_to_string(Name))]))\n )\n then\n det_insert({InputNum, ImportId}, link_to(ClosureId), !LinkMap)\n else\n pz_new_import(NewImportId, Import, !PZ),\n det_insert({InputNum, ImportId}, link_external(NewImportId),\n !LinkMap)\n )\n ; ImportType = pzit_foreign,\n pz_new_import(NewImportId, Import, !PZ),\n det_insert({InputNum, ImportId}, link_external(NewImportId),\n !LinkMap)\n ).\n\n:- pred link_structs(id_map::in, pz::in, int::in, int::out,\n pz::in, pz::out) is det.\n\nlink_structs(IdMap, Input, InputNum, InputNum+1, !PZ) :-\n Structs = pz_get_structs(Input),\n foldl(link_structs_2(IdMap, InputNum), Structs, !PZ).\n\n:- pred link_structs_2(id_map::in, int::in, pair(pzs_id, pz_named_struct)::in,\n pz::in, pz::out) is det.\n\nlink_structs_2(IdMap, InputNum, SId0 - pz_named_struct(Name, Struct), !PZ) :-\n SId = transform_struct_id(!.PZ, IdMap, InputNum, SId0),\n pz_add_struct(SId, Name, Struct, !PZ).\n\n:- pred link_datas(id_map::in, link_map::in, pz::in, int::in, int::out,\n pz::in, pz::out) is det.\n\nlink_datas(IdMap, LinkMap, Input, InputNum, InputNum+1, !PZ) :-\n Datas = pz_get_data_items(Input),\n foldl(link_datas_2(IdMap, LinkMap, InputNum), Datas, !PZ).\n\n:- pred link_datas_2(id_map::in, link_map::in, int::in,\n pair(pzd_id, pz_data)::in, pz::in, pz::out) is det.\n\nlink_datas_2(IdMap, LinkMap, InputNum, DataId0 - Data0, !PZ) :-\n Data0 = pz_data(Type0, Values0),\n ( Type0 = type_array(_, _),\n Type = Type0\n ; Type0 = type_struct(OldId),\n NewId = transform_struct_id(!.PZ, IdMap, InputNum, OldId),\n Type = type_struct(NewId)\n ; Type0 = type_string(_),\n Type = Type0\n ),\n Values = map(transform_value(!.PZ, IdMap, LinkMap, InputNum), Values0),\n Data = pz_data(Type, Values),\n\n DataId = transform_data_id(!.PZ, IdMap, InputNum, DataId0),\n pz_add_data(DataId, Data, !PZ).\n\n:- pred link_procs(id_map::in, link_map::in, pz::in, int::in, int::out,\n pz::in, pz::out) is det.\n\nlink_procs(IdMap, LinkMap, Input, InputNum, InputNum+1, !PZ) :-\n Procs = pz_get_procs(Input),\n foldl(link_proc(IdMap, LinkMap, InputNum), Procs, !PZ).\n\n:- pred link_proc(id_map::in, link_map::in, int::in,\n pair(pzp_id, pz_proc)::in, pz::in, pz::out) is det.\n\nlink_proc(IdMap, LinkMap, Input, ProcId0 - Proc0, !PZ) :-\n pz_proc(Name, Signature, MaybeBlocks0) = Proc0,\n ( MaybeBlocks0 = no,\n MaybeBlocks = no\n ; MaybeBlocks0 = yes(Blocks0),\n Blocks = map(link_block(!.PZ, IdMap, LinkMap, Input), Blocks0),\n MaybeBlocks = yes(Blocks)\n ),\n Proc = pz_proc(Name, Signature, MaybeBlocks),\n ProcId = transform_proc_id(!.PZ, IdMap, Input, ProcId0),\n pz_add_proc(ProcId, Proc, !PZ).\n\n:- func link_block(pz, id_map, link_map, int, pz_block) = pz_block.\n\nlink_block(PZ, IdMap, LinkMap, Input, pz_block(Instrs)) =\n pz_block(map(link_instr_obj(PZ, IdMap, LinkMap, Input), Instrs)).\n\n:- func link_instr_obj(pz, id_map, link_map, int, pz_instr_obj) = pz_instr_obj.\n\nlink_instr_obj(PZ, IdMap, LinkMap, Input, pzio_instr(Instr)) =\n pzio_instr(link_instr(PZ, IdMap, LinkMap, Input, Instr)).\nlink_instr_obj(PZ, IdMap, _, Input, pzio_context(Context)) =\n pzio_context(link_context(PZ, IdMap, Input, Context)).\nlink_instr_obj(_, _, _, _, pzio_comment(Comment)) =\n pzio_comment(Comment).\n\n:- func link_instr(pz, id_map, link_map, int, pz_instr) = pz_instr.\n\nlink_instr(PZ, IdMap, LinkMap, Input, Instr0) = Instr :-\n instruction(Instr0, Opcode, Width, MaybeImm0),\n ( MaybeImm0 = no,\n MaybeImm = no\n ; MaybeImm0 = yes(Imm0),\n (\n ( Imm0 = pz_im_i8(_)\n ; Imm0 = pz_im_u8(_)\n ; Imm0 = pz_im_i16(_)\n ; Imm0 = pz_im_u16(_)\n ; Imm0 = pz_im_i32(_)\n ; Imm0 = pz_im_u32(_)\n ; Imm0 = pz_im_i64(_)\n ; Imm0 = pz_im_u64(_)\n ; Imm0 = pz_im_label(_)\n ; Imm0 = pz_im_depth(_)\n ),\n Imm = Imm0\n ; Imm0 = pz_im_closure(CloId),\n Imm = pz_im_closure(transform_closure_id(PZ, IdMap, Input, CloId))\n ; Imm0 = pz_im_proc(ProcId),\n Imm = pz_im_proc(transform_proc_id(PZ, IdMap, Input, ProcId))\n ; Imm0 = pz_im_import(ImportId),\n LinkDest = transform_import_id(LinkMap, Input, ImportId),\n ( LinkDest = link_to(ClosureId),\n Imm = pz_im_closure(ClosureId)\n ; LinkDest = link_external(NewImportId),\n Imm = pz_im_import(NewImportId)\n )\n ; Imm0 = pz_im_struct(StructId),\n Imm = pz_im_struct(transform_struct_id(PZ, IdMap, Input, StructId))\n ; Imm0 = pz_im_struct_field(StructId, FieldNo),\n Imm = pz_im_struct_field(\n transform_struct_id(PZ, IdMap, Input, StructId),\n FieldNo)\n ),\n MaybeImm = yes(Imm)\n ),\n ( if instruction(InstrPrime, Opcode, Width, MaybeImm) then\n Instr = InstrPrime\n else\n unexpected($file, $pred, \"Instruction encoding bug\")\n ).\n\n:- func link_context(pz, id_map, int, pz_context) = pz_context.\n\nlink_context(PZ, IdMap, InputNum, pz_context(OrigContext, FileData)) =\n pz_context(OrigContext, transform_data_id(PZ, IdMap, InputNum, FileData)).\nlink_context(_, _, _, pz_context_short(Line)) =\n pz_context_short(Line).\nlink_context(_, _, _, pz_nil_context) =\n pz_nil_context.\n\n:- pred link_closures(id_map::in, pz::in, int::in, int::out, pz::in, pz::out)\n is det.\n\nlink_closures(IdMap, Input, InputNum, InputNum+1, !PZ) :-\n Closures = pz_get_closures(Input),\n foldl(link_closure(IdMap, InputNum), Closures, !PZ).\n\n:- pred link_closure(id_map::in, int::in, pair(pzc_id, pz_closure)::in,\n pz::in, pz::out) is det.\n\nlink_closure(IdMap, InputNum, CID0 - pz_closure(Proc, Data), !PZ) :-\n Closure = pz_closure(\n transform_proc_id(!.PZ, IdMap, InputNum, Proc),\n transform_data_id(!.PZ, IdMap, InputNum, Data)),\n CID = transform_closure_id(!.PZ, IdMap, InputNum, CID0),\n pz_add_closure(CID, Closure, !PZ).\n\n:- func find_entrypoint(pz, id_map, list(pz), map(q_name, {int, pz}),\n maybe(q_name)) = result(maybe(pz_entrypoint), link_error).\n\nfind_entrypoint(PZ, IdMap, _, ModNameMap, yes(EntryName)) = Result :-\n q_name_parts(EntryName, MbEntryModName, EntryFuncPart),\n ( MbEntryModName = yes(EntryModName),\n ( if map.search(ModNameMap, EntryModName, {ModuleNum, Module}) then\n ( if\n promise_equivalent_solutions [Entry0] (\n search(pz_get_exports(Module), EntryName, EntryClo),\n member(Entry0, get_entrypoints(Module)),\n pz_entrypoint(EntryClo, _, _) = Entry0\n )\n then\n Result = ok(yes(\n translate_entrypoint(PZ, IdMap, ModuleNum, Entry0)))\n else\n Result = return_error(command_line_context,\n format(\n \"Module `%s` does not contain an entrypoint named '%s'\",\n [s(q_name_to_string(EntryModName)),\n s(nq_name_to_string(EntryFuncPart))]))\n )\n else\n Result = return_error(command_line_context,\n format(\"Cannot find entry module `%s`\",\n [s(q_name_to_string(EntryModName))]))\n )\n ; MbEntryModName = no,\n Result = return_error(command_line_context,\n format(\"Entrypoint '%s' is not fully qualified\",\n [s(q_name_to_string(EntryName))]))\n ).\nfind_entrypoint(PZ, IdMap, Inputs, _, no) = Result :-\n map_foldl(get_translate_entrypoints(PZ, IdMap), Inputs, Entrypoints0, 0, _),\n Entrypoints = condense(Entrypoints0),\n ( if\n Entrypoints = [Entry]\n then\n Result = ok(yes(Entry))\n else\n % We assume we're building a program, libraries will be an explicit\n % option, so that makes this an error.\n Result = return_error(nil_context,\n format(\"No unique entrypoint found, found %d entrypoints\",\n [i(length(Entrypoints))]))\n ).\n\n:- func get_entrypoints(pz) = list(pz_entrypoint).\n\nget_entrypoints(Module) =\n maybe_list(pz_get_maybe_entry_closure(Module)) ++\n to_sorted_list(pz_get_entry_candidates(Module)).\n\n:- func translate_entrypoint(pz, id_map, int, pz_entrypoint) =\n pz_entrypoint.\n\ntranslate_entrypoint(PZ, IdMap, ModuleNum, Entry0) = Entry :-\n pz_entrypoint(CloId0, Signature, Name) = Entry0,\n CloId = transform_closure_id(PZ, IdMap, ModuleNum, CloId0),\n pz_entrypoint(CloId, Signature, Name) = Entry.\n\n:- pred get_translate_entrypoints(pz::in, id_map::in, pz::in,\n list(pz_entrypoint)::out, int::in, int::out) is det.\n\nget_translate_entrypoints(PZ, IdMap, Module, Entries, Num, Num + 1) :-\n Entries = map(translate_entrypoint(PZ, IdMap, Num),\n get_entrypoints(Module)).\n\n%-----------------------------------------------------------------------%\n\n:- func transform_value(pz, id_map, link_map, int, pz_data_value) =\n pz_data_value.\n\ntransform_value(_, _, _, _, pzv_num(Num)) =\n pzv_num(Num).\ntransform_value(PZ, IdMap, _, Input, pzv_data(OldId)) =\n pzv_data(NewId) :-\n NewId = transform_data_id(PZ, IdMap, Input, OldId).\ntransform_value(_, _, LinkMap, Input, pzv_import(OldId)) =\n Value :-\n LinkDest = transform_import_id(LinkMap, Input, OldId),\n ( LinkDest = link_to(ClosureId),\n Value = pzv_closure(ClosureId)\n ; LinkDest = link_external(NewImportId),\n Value = pzv_import(NewImportId)\n ).\ntransform_value(PZ, IdMap, _, Input, pzv_closure(OldId)) =\n pzv_closure(NewId) :-\n NewId = transform_closure_id(PZ, IdMap, Input, OldId).\n\n%-----------------------------------------------------------------------%\n\n:- type link_map ==\n map({int, pzi_id}, link_dest).\n\n:- type link_dest\n ---> link_to(pzc_id)\n ; link_external(pzi_id).\n\n:- type id_map\n ---> id_map(\n idm_struct_offsets :: array(uint32),\n idm_data_offsets :: array(uint32),\n idm_proc_offsets :: array(uint32),\n idm_closure_offsets :: array(uint32)\n ).\n\n:- type export_map == map(q_name, map(q_name, pzc_id)).\n\n:- pred build_input_maps(list(pz)::in, id_map::out, map(q_name, {int, pz})::out,\n uint32::out, uint32::out, uint32::out, uint32::out) is det.\n\nbuild_input_maps(Inputs, IdMap, NameMap, NumStructs, NumDatas, NumProcs,\n NumClosures) :-\n calculate_offsets_and_build_maps(Inputs, 0,\n 0u32, NumStructs, [], StructOffsetsList,\n 0u32, NumDatas, [], DataOffsetsList,\n 0u32, NumProcs, [], ProcOffsetsList,\n 0u32, NumClosures, [], ClosureOffsetsList,\n init, NameMap),\n StructOffsets = array(StructOffsetsList),\n DataOffsets = array(DataOffsetsList),\n ProcOffsets = array(ProcOffsetsList),\n ClosureOffsets = array(ClosureOffsetsList),\n\n IdMap = id_map(StructOffsets, DataOffsets, ProcOffsets, ClosureOffsets).\n\n:- pred calculate_offsets_and_build_maps(list(pz)::in, int::in,\n uint32::in, uint32::out, list(uint32)::in, list(uint32)::out,\n uint32::in, uint32::out, list(uint32)::in, list(uint32)::out,\n uint32::in, uint32::out, list(uint32)::in, list(uint32)::out,\n uint32::in, uint32::out, list(uint32)::in, list(uint32)::out,\n map(q_name, {int, pz})::in, map(q_name, {int, pz})::out) is det.\n\ncalculate_offsets_and_build_maps([], _,\n !NumStructs, !StructOffsets,\n !NumDatas, !DataOffsets,\n !NumProcs, !ProcOffsets,\n !NumClosures, !ClosureOffsets,\n !NameMap) :-\n reverse(!StructOffsets),\n reverse(!DataOffsets),\n reverse(!ProcOffsets),\n reverse(!ClosureOffsets).\ncalculate_offsets_and_build_maps([Input | Inputs], ModuleNum,\n !StructOffset, !StructOffsets,\n !DataOffset, !DataOffsets,\n !ProcOffset, !ProcOffsets,\n !ClosureOffset, !ClosureOffsets,\n !NameMap) :-\n\n !:StructOffset = !.StructOffset + pz_get_num_structs(Input),\n !:StructOffsets = [!.StructOffset | !.StructOffsets],\n\n !:DataOffset = !.DataOffset + pz_get_num_datas(Input),\n !:DataOffsets = [!.DataOffset | !.DataOffsets],\n\n !:ProcOffset = !.ProcOffset + pz_get_num_procs(Input),\n !:ProcOffsets = [!.ProcOffset | !.ProcOffsets],\n\n !:ClosureOffset = !.ClosureOffset + pz_get_num_closures(Input),\n !:ClosureOffsets = [!.ClosureOffset | !.ClosureOffsets],\n\n foldl((pred(N::in, NM0::in, NM::out) is det :-\n ( if insert(N, {ModuleNum, Input}, NM0, NM1) then\n NM = NM1\n else\n compile_error($file, $pred,\n \"Cannot link two modules containing the same module\")\n )\n ), pz_get_module_names(Input), !NameMap),\n\n calculate_offsets_and_build_maps(Inputs, ModuleNum + 1,\n !StructOffset, !StructOffsets,\n !DataOffset, !DataOffsets,\n !ProcOffset, !ProcOffsets,\n !ClosureOffset, !ClosureOffsets,\n !NameMap).\n\n%-----------------------------------------------------------------------%\n\n:- func transform_import_id(link_map, int, pzi_id) = link_dest.\n\ntransform_import_id(LinkMap, InputNum, OldId) = LinkDest :-\n lookup(LinkMap, {InputNum, OldId}, LinkDest).\n\n:- func transform_struct_id(pz, id_map, int, pzs_id) = pzs_id.\n\ntransform_struct_id(PZ, IdMap, InputNum, OldId) =\n transform_id(pzs_id_get_num, pzs_id_from_num(PZ),\n IdMap ^ idm_struct_offsets, InputNum, OldId).\n\n:- func transform_data_id(pz, id_map, int, pzd_id) = pzd_id.\n\ntransform_data_id(PZ, IdMap, InputNum, OldId) =\n transform_id(pzd_id_get_num, pzd_id_from_num(PZ),\n IdMap ^ idm_data_offsets, InputNum, OldId).\n\n:- func transform_proc_id(pz, id_map, int, pzp_id) = pzp_id.\n\ntransform_proc_id(PZ, IdMap, InputNum, ProcId) =\n transform_id(pzp_id_get_num, pzp_id_from_num(PZ),\n IdMap ^ idm_proc_offsets, InputNum, ProcId).\n\n:- func transform_closure_id(pz, id_map, int, pzc_id) = pzc_id.\n\ntransform_closure_id(PZ, IdMap, InputNum, ClosureId) =\n transform_id(pzc_id_get_num, pzc_id_from_num(PZ),\n IdMap ^ idm_closure_offsets, InputNum, ClosureId).\n\n:- func transform_id(func(Id) = uint32, pred(uint32, Id),\n array(uint32), int, Id) = Id.\n:- mode transform_id(in, pred(in, out) is semidet,\n in, in, in) = (out) is det.\n\ntransform_id(GetNum, FromNum, Offsets, InputNum, OldId) = NewId :-\n ( if InputNum > 0 then\n OldIdNum = GetNum(OldId),\n NewIdNum = OldIdNum + Offsets ^ elem(InputNum - 1),\n ( if FromNum(NewIdNum, NewIdPrime) then\n NewId = NewIdPrime\n else\n unexpected($file, $pred, \"Bad id\")\n )\n else\n NewId = OldId\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pz.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pz.\n%\n% Low level plasma data structure.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module list.\n\n:- import_module q_name.\n:- import_module pz.pz_ds.\n\n:- include_module pz.code.\n:- include_module pz.pretty.\n:- include_module pz.pz_ds.\n:- include_module pz.link.\n:- include_module pz.read.\n:- include_module pz.write.\n\n%-----------------------------------------------------------------------%\n%\n% Common definitions\n%\n\n:- type pz_file_type\n ---> pzft_program\n ; pzft_library\n ; pzft_object.\n\n% TODO: Separate structs into new entries. Allow arrays of structs.\n% TODO: Allow data to reference code.\n% TODO: Re-arrange data and value types to better match the on-disk format.\n\n:- type pz_struct\n ---> pz_struct(list(pz_width)).\n\n % A data type.\n %\n % Note that types aren't defined recursively. All PZ cares about is the\n % width and padding of data, so we don't need recursive definitions.\n % There is one place where recursive definitions would be useful but the\n % costs outweigh the benefit, and the workaround is simple.\n %\n:- type pz_data_type\n ---> type_array(\n pza_width :: pz_width,\n pza_num_items :: int\n )\n ; type_struct(\n pzs_id :: pzs_id\n )\n ; type_string(\n pzs_c_units :: int\n ).\n\n % A static data entry\n %\n:- type pz_data\n ---> pz_data(pz_data_type, list(pz_data_value)).\n\n:- type pz_closure\n ---> pz_closure(pzp_id, pzd_id).\n\n:- type pz_import_type\n % Import from another module.\n ---> pzit_import\n\n % Import from foreign code, the imported thing probably has the\n % same module name as this module.\n ; pzit_foreign.\n\n:- type pz_import\n ---> pz_import(\n pzi_name :: q_name,\n pzi_type :: pz_import_type\n ).\n\n%\n% PZ isn't typed like a high level language. The only things PZ needs to\n% know are data widths (for alignment and padding).\n%\n\n:- type pz_width\n ---> pzw_8\n ; pzw_16\n ; pzw_32\n ; pzw_64\n ; pzw_fast\n ; pzw_ptr.\n\n:- type pz_data_value\n ---> pzv_num(int)\n ; pzv_data(pzd_id)\n ; pzv_import(pzi_id)\n ; pzv_closure(pzc_id).\n\n%-----------------------------------------------------------------------%\n\n:- type pz_named_struct\n ---> pz_named_struct(\n pzs_name :: string,\n pzs_struct :: pz_struct\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func pz_encode_string(string) = pz_data.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module char.\n:- import_module string.\n\n:- include_module pz.bytecode.\n:- include_module pz.format.\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_decl(\"C\", include_file(\"../runtime/pz_common.h\")).\n:- pragma foreign_decl(\"C\", include_file(\"../runtime/pz_format.h\")).\n\n:- pragma foreign_enum(\"C\", pz_import_type/0, [\n pzit_import - \"PZ_IMPORT_IMPORT\",\n pzit_foreign - \"PZ_IMPORT_FOREIGN\"\n]).\n\n:- pragma foreign_enum(\"C\", pz_width/0, [\n pzw_8 - \"PZW_8\",\n pzw_16 - \"PZW_16\",\n pzw_32 - \"PZW_32\",\n pzw_64 - \"PZW_64\",\n pzw_fast - \"PZW_FAST\",\n pzw_ptr - \"PZW_PTR\"\n]).\n\n%-----------------------------------------------------------------------%\n\npz_encode_string(String) = Data :-\n Values = map(func(C) = pzv_num(to_int(C)), to_char_list(String)),\n Data = pz_data(type_string(length(Values)), Values).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pz.pretty.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pz.pretty.\n%\n% PZ pretty printer\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module cord.\n:- import_module string.\n\n:- func pz_pretty(pz) = cord(string).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module int.\n:- import_module maybe.\n:- import_module pair.\n:- import_module require.\n:- import_module set.\n:- import_module uint32.\n\n:- import_module context.\n:- import_module pz.code.\n:- import_module util.\n:- import_module util.pretty_old.\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\npz_pretty(PZ) =\n condense(ModuleDeclsPretty) ++ nl ++\n condense(ImportsPretty) ++ nl ++\n condense(StructsPretty) ++ nl ++\n condense(DataPretty) ++ nl ++\n condense(ProcsPretty) ++ nl ++\n condense(ClosuresPretty) ++ nl :-\n ModuleDeclsPretty = from_list(map(module_decl_pretty,\n pz_get_module_names(PZ))),\n ImportsPretty = from_list(map(import_pretty, pz_get_imports(PZ))),\n StructsPretty = from_list(map(struct_pretty, pz_get_structs(PZ))),\n DataPretty = from_list(map(data_pretty, pz_get_data_items(PZ))),\n ProcsPretty = from_list(map(proc_pretty(PZ), pz_get_procs(PZ))),\n ClosuresPretty = from_list(map(closure_pretty(PZ),\n pz_get_closures(PZ))).\n\n:- func module_decl_pretty(q_name) = cord(string).\n\nmodule_decl_pretty(Name) =\n cord.from_list([\"module \", q_name_to_string(Name)]) ++ nl.\n\n%-----------------------------------------------------------------------%\n\n:- func import_pretty(pair(pzi_id, pz_import)) = cord(string).\n\nimport_pretty(IID - pz_import(Name, Type)) =\n from_list([Label, string(pzi_id_get_num(IID)), \" \",\n q_name_to_string(Name), \";\\n\"]) :-\n ( Type = pzit_import,\n Label = \"import \"\n ; Type = pzit_foreign,\n Label = \"foreign \"\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func struct_pretty(pair(pzs_id, pz_named_struct)) = cord(string).\n\nstruct_pretty(SID - pz_named_struct(Name, pz_struct(Fields))) = String :-\n SIDNum = pzs_id_get_num(SID),\n\n String = from_list([\"struct \", Name, \"_\", string(SIDNum), \" = { \"]) ++\n join(comma ++ spc, map(width_pretty, Fields)) ++ singleton(\" }\\n\").\n\n%-----------------------------------------------------------------------%\n\n:- func data_pretty(pair(pzd_id, pz_data)) = cord(string).\n\ndata_pretty(DID - pz_data(Type, Values)) = String :-\n DIDNum = pzd_id_get_num(DID),\n DeclStr = format(\"data d%d = \", [i(cast_to_int(DIDNum))]),\n\n TypeStr = data_type_pretty(Type),\n\n DataStr = singleton(\"{ \") ++ join(spc,\n map(data_value_pretty, Values)) ++\n singleton(\" }\"),\n\n String = singleton(DeclStr) ++ TypeStr ++ spc ++ DataStr ++ semicolon ++ nl.\n\n:- func data_type_pretty(pz_data_type) = cord(string).\n\ndata_type_pretty(type_array(Width, _)) = cons(\"array(\",\n snoc(width_pretty(Width), \")\")).\ndata_type_pretty(type_struct(StructId)) = singleton(StructName) :-\n StructName = format(\"struct_%d\",\n [i(cast_to_int(pzs_id_get_num(StructId)))]).\ndata_type_pretty(type_string(_)) = singleton(\"string\").\n\n:- func data_value_pretty(pz_data_value) = cord(string).\n\ndata_value_pretty(pzv_num(Num)) =\n singleton(string(Num)).\ndata_value_pretty(Value) =\n singleton(format(\"%s%i\", [s(Label), i(cast_to_int(IdNum))])) :-\n ( Value = pzv_data(DID),\n Label = \"d\",\n IdNum = pzd_id_get_num(DID)\n ; Value = pzv_import(IID),\n Label = \"i\",\n IdNum = pzi_id_get_num(IID)\n ; Value = pzv_closure(CID),\n Label = \"c\",\n IdNum = pzc_id_get_num(CID)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func proc_pretty(pz, pair(pzp_id, pz_proc)) = cord(string).\n\nproc_pretty(PZ, PID - Proc) = String :-\n Name = pretty_proc_name(PID, Proc),\n Inputs = Proc ^ pzp_signature ^ pzs_before,\n Outputs = Proc ^ pzp_signature ^ pzs_after,\n ParamsStr = join(spc, map(width_pretty, Inputs)) ++\n singleton(\" - \") ++\n join(spc, map(width_pretty, Outputs)),\n\n DeclStr = singleton(\"proc \") ++ singleton(Name) ++ singleton(\" (\") ++\n ParamsStr ++ singleton(\")\"),\n\n MaybeBlocks = Proc ^ pzp_blocks,\n ( MaybeBlocks = yes(Blocks),\n ( Blocks = [],\n unexpected($file, $pred, \"no blocks\")\n ; Blocks = [Block],\n BlocksStr = pretty_block(PZ, Block)\n ; Blocks = [_, _ | _],\n map_foldl(pretty_block_with_name(PZ), Blocks, BlocksStr0, 0, _),\n BlocksStr = cord_list_to_cord(BlocksStr0)\n ),\n BodyStr = singleton(\" {\\n\") ++ BlocksStr ++ singleton(\"}\")\n ; MaybeBlocks = no,\n BodyStr = init\n ),\n\n String = DeclStr ++ BodyStr ++ semicolon ++ nl ++ nl.\n\n:- func pretty_proc_name(pzp_id, pz_proc) = string.\n\npretty_proc_name(PID, Proc) =\n format(\"%s_%d\", [s(q_name_to_string(Proc ^ pzp_name)),\n i(cast_to_int(pzp_id_get_num(PID)))]).\n\n:- pred pretty_block_with_name(pz::in, pz_block::in, cord(string)::out,\n int::in, int::out) is det.\n\npretty_block_with_name(PZ, pz_block(Instrs), String, !Num) :-\n String = indent(2) ++ singleton(format(\"block b%d {\\n\", [i(!.Num)])) ++\n pretty_instrs(PZ, 4, Instrs) ++\n indent(2) ++ singleton(\"}\\n\"),\n !:Num = !.Num + 1.\n\n:- func pretty_block(pz, pz_block) = cord(string).\n\npretty_block(PZ, pz_block(Instrs)) = pretty_instrs(PZ, 2, Instrs).\n\n:- func pretty_instrs(pz, int, list(pz_instr_obj)) = cord(string).\n\npretty_instrs(_, _, []) = init.\npretty_instrs(PZ, Indent, [Instr | Instrs]) =\n indent(Indent) ++ pretty_instr_obj(PZ, Instr) ++ nl ++\n pretty_instrs(PZ, Indent, Instrs).\n\n:- func pretty_instr_obj(pz, pz_instr_obj) = cord(string).\n\npretty_instr_obj(PZ, pzio_instr(Instr)) = pretty_instr(PZ, Instr).\npretty_instr_obj(_, pzio_context(PZContext)) = Pretty :-\n ( PZContext = pz_context(Context, _),\n Pretty = comment ++ singleton(context_string(Context))\n ; PZContext = pz_context_short(Line),\n Pretty = comment ++ singleton(\":\" ++ string(Line))\n ; PZContext = pz_nil_context,\n Pretty = empty\n ).\npretty_instr_obj(_, pzio_comment(Comment)) =\n comment ++ singleton(Comment).\n\n:- func pretty_instr(pz, pz_instr) = cord(string).\n\npretty_instr(PZ, Instr) = String :-\n ( Instr = pzi_load_immediate(Width, Value),\n (\n ( Value = im_i8(Num),\n NumStr = string(Num)\n ; Value = im_u8(Num),\n NumStr = string(Num)\n ; Value = im_i16(Num),\n NumStr = string(Num)\n ; Value = im_u16(Num),\n NumStr = string(Num)\n ; Value = im_i32(Num),\n NumStr = string(Num)\n ; Value = im_u32(Num),\n NumStr = string(Num)\n ; Value = im_i64(Num),\n NumStr = string(Num)\n ; Value = im_u64(Num),\n NumStr = string(Num)\n ),\n String = singleton(NumStr) ++ colon ++ width_pretty(Width)\n )\n ;\n ( Instr = pzi_ze(Width1, Width2),\n Name = \"ze\"\n ; Instr = pzi_se(Width1, Width2),\n Name = \"se\"\n ; Instr = pzi_trunc(Width1, Width2),\n Name = \"trunc\"\n ),\n String = singleton(Name) ++ colon ++\n width_pretty(Width1) ++ comma ++ width_pretty(Width2)\n ;\n ( Instr = pzi_add(Width),\n Name = \"add\"\n ; Instr = pzi_sub(Width),\n Name = \"sub\"\n ; Instr = pzi_mul(Width),\n Name = \"mul\"\n ; Instr = pzi_div(Width),\n Name = \"div\"\n ; Instr = pzi_mod(Width),\n Name = \"mod\"\n ; Instr = pzi_lshift(Width),\n Name = \"lshift\"\n ; Instr = pzi_rshift(Width),\n Name = \"rshift\"\n ; Instr = pzi_and(Width),\n Name = \"and\"\n ; Instr = pzi_or(Width),\n Name = \"or\"\n ; Instr = pzi_xor(Width),\n Name = \"xor\"\n ; Instr = pzi_lt_u(Width),\n Name = \"lt_u\"\n ; Instr = pzi_lt_s(Width),\n Name = \"lt_s\"\n ; Instr = pzi_gt_u(Width),\n Name = \"gt_u\"\n ; Instr = pzi_gt_s(Width),\n Name = \"gt_s\"\n ; Instr = pzi_eq(Width),\n Name = \"eq\"\n ; Instr = pzi_not(Width),\n Name = \"not\"\n ; Instr = pzi_cjmp(Dest, Width),\n Name = format(\"cjmp b%d\", [i(cast_to_int(Dest))])\n ),\n String = singleton(Name) ++ colon ++ width_pretty(Width)\n ;\n ( Instr = pzi_call(Callee),\n InstrName = \"call\"\n ; Instr = pzi_tcall(Callee),\n InstrName = \"tcall\"\n ),\n ( Callee = pzc_closure(CID),\n CalleeName = format(\"closure_%d\", [i(\n cast_to_int(pzc_id_get_num(CID)))])\n ;\n ( Callee = pzc_import(IID),\n CalleeSym = pz_lookup_import(PZ, IID) ^ pzi_name\n ; Callee = pzc_proc_opt(PID),\n CalleeSym = pz_lookup_proc(PZ, PID) ^ pzp_name\n ),\n CalleeName = q_name_to_string(CalleeSym)\n ),\n String = singleton(InstrName) ++ spc ++ singleton(CalleeName)\n ;\n ( Instr = pzi_drop,\n Name = \"drop\"\n ; Instr = pzi_call_ind,\n Name = \"call_ind\"\n ; Instr = pzi_tcall_ind,\n Name = \"tcall_ind\"\n ; Instr = pzi_jmp(Dest),\n Name = format(\"jmp %d\", [i(cast_to_int(Dest))])\n ; Instr = pzi_ret,\n Name = \"ret\"\n ; Instr = pzi_get_env,\n Name = \"get_env\"\n ),\n String = singleton(Name)\n ;\n ( Instr = pzi_roll(N),\n Name = \"roll \"\n ; Instr = pzi_pick(N),\n Name = \"pick \"\n ),\n String = singleton(Name) ++ singleton(string(N))\n ; Instr = pzi_alloc(Struct),\n String = singleton(format(\"alloc struct_%d\",\n [i(cast_to_int(pzs_id_get_num(Struct)))]))\n ; Instr = pzi_make_closure(Proc),\n String = singleton(format(\"make_closure_%d\",\n [i(cast_to_int(pzp_id_get_num(Proc)))]))\n ;\n ( Instr = pzi_load(Struct, Field, Width),\n Name = \"load\"\n ; Instr = pzi_store(Struct, Field, Width),\n Name = \"store\"\n ),\n String = singleton(Name) ++ colon ++ width_pretty(Width) ++ spc ++\n singleton(string(pzs_id_get_num(Struct))) ++ spc ++\n singleton(string(Field))\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func closure_pretty(pz, pair(pzc_id, pz_closure)) = cord(string).\n\nclosure_pretty(PZ, Id - pz_closure(ProcId, DataId)) =\n CloPretty ++ EntryPretty :-\n Proc = pz_lookup_proc(PZ, ProcId),\n ProcName = pretty_proc_name(ProcId, Proc),\n DataName = format(\"d%d\", [i(cast_to_int(pzd_id_get_num(DataId)))]),\n CloPretty = ExportPretty ++ from_list(\n [\"closure \", Name, \" = \", ProcName, \" \", DataName, \";\\n\"]),\n ( if\n find_first_match((pred((_ - EId)::in) is semidet :-\n Id = EId\n ), pz_get_exports(PZ), Export),\n Export = ExportName0 - Id\n then\n ExportPretty = singleton(\"export \"),\n Name = q_name_to_string(ExportName0)\n else\n ExportPretty = init,\n Name = format(\"clo_%d\", [i(cast_to_int(pzc_id_get_num(Id)))])\n ),\n ( if\n ( if\n pz_get_maybe_entry_closure(PZ) = yes(Entry),\n Id = Entry ^ pz_ep_closure\n then\n Type = \"default \"\n else if\n member(Entry, pz_get_entry_candidates(PZ)),\n Id = Entry ^ pz_ep_closure\n then\n Type = \"candidate \"\n else\n false\n )\n then\n EntryPretty = from_list([\"entry \", Type, Name, \";\\n\"])\n else\n EntryPretty = init\n ).\n\n%-----------------------------------------------------------------------%\n\n:- func width_pretty(pz_width) = cord(string).\n\nwidth_pretty(Width) = singleton(width_pretty_str(Width)).\n\n:- func width_pretty_str(pz_width) = string.\n\nwidth_pretty_str(pzw_8) = \"w8\".\nwidth_pretty_str(pzw_16) = \"w16\".\nwidth_pretty_str(pzw_32) = \"w32\".\nwidth_pretty_str(pzw_64) = \"w64\".\n% TODO: check that these match what the parser expects, standardize on some\n% names for these throughout the system.\nwidth_pretty_str(pzw_fast) = \"w\".\nwidth_pretty_str(pzw_ptr) = \"ptr\".\n\n:- func comment = cord(string).\n\ncomment = singleton(\"// \").\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pz.pz_ds.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pz.pz_ds.\n%\n% Low level plasma data structure.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module assoc_list.\n:- import_module map.\n:- import_module maybe.\n:- import_module set.\n\n:- import_module pz.code.\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\n % Structure ID\n %\n:- type pzs_id.\n\n:- func pzs_id_get_num(pzs_id) = uint32.\n\n:- pred pzs_id_from_num(pz::in, uint32::in, pzs_id::out) is semidet.\n\n % Imported procedure ID\n %\n:- type pzi_id.\n\n:- func pzi_id_get_num(pzi_id) = uint32.\n\n:- pred pzi_id_from_num(pz::in, uint32::in, pzi_id::out) is semidet.\n\n % Procedure ID\n %\n:- type pzp_id.\n\n:- func pzp_id_get_num(pzp_id) = uint32.\n\n:- pred pzp_id_from_num(pz::in, uint32::in, pzp_id::out) is semidet.\n\n % Data ID\n %\n:- type pzd_id.\n\n:- func pzd_id_get_num(pzd_id) = uint32.\n:- pred pzd_id_from_num(pz::in, uint32::in, pzd_id::out) is semidet.\n\n % Closure ID\n %\n:- type pzc_id.\n\n:- func pzc_id_get_num(pzc_id) = uint32.\n\n:- pred pzc_id_from_num(pz::in, uint32::in, pzc_id::out) is semidet.\n\n%-----------------------------------------------------------------------%\n\n:- type pz.\n\n%-----------------------------------------------------------------------%\n\n % init_pz(ModuleNames, FileType)\n % init_pz(ModuleNames, FileType, NumImports, NumStructs, NumProcs, NumDatas,\n % NumClosures).\n %\n:- func init_pz(list(q_name), pz_file_type) = pz.\n:- func init_pz(list(q_name), pz_file_type, uint32, uint32, uint32, uint32,\n uint32) = pz.\n\n%-----------------------------------------------------------------------%\n\n:- func pz_get_module_names(pz) = list(q_name).\n\n:- func pz_get_file_type(pz) = pz_file_type.\n\n%-----------------------------------------------------------------------%\n\n:- type pz_entrypoint\n ---> pz_entrypoint(\n pz_ep_closure :: pzc_id,\n pz_ep_signature :: pz_entry_signature,\n pz_ep_name :: q_name\n ).\n\n:- pred pz_set_entry_closure(pzc_id::in, pz_entry_signature::in,\n pz::in, pz::out) is det.\n\n:- func pz_get_maybe_entry_closure(pz) = maybe(pz_entrypoint).\n\n:- pred pz_add_entry_candidate(pzc_id::in, pz_entry_signature::in,\n pz::in, pz::out) is det.\n\n:- func pz_get_entry_candidates(pz) = set(pz_entrypoint).\n\n%-----------------------------------------------------------------------%\n\n:- func pz_get_structs(pz) = assoc_list(pzs_id, pz_named_struct).\n\n:- func pz_get_num_structs(pz) = uint32.\n\n:- func pz_get_struct_names_map(pz) = map(pzs_id, string).\n\n:- func pz_lookup_struct(pz, pzs_id) = pz_struct.\n\n:- pred pz_new_struct_id(pzs_id::out, string::in, pz::in, pz::out) is det.\n\n:- pred pz_add_struct(pzs_id::in, pz_struct::in, pz::in, pz::out) is det.\n:- pred pz_add_struct(pzs_id::in, string::in, pz_struct::in, pz::in, pz::out)\n is det.\n\n%-----------------------------------------------------------------------%\n\n:- func pz_get_imports(pz) = assoc_list(pzi_id, pz_import).\n\n:- func pz_get_num_imports(pz) = uint32.\n\n:- func pz_lookup_import(pz, pzi_id) = pz_import.\n\n:- pred pz_new_import(pzi_id::out, pz_import::in, pz::in, pz::out) is det.\n\n:- pred pz_add_import(pzi_id::in, pz_import::in, pz::in, pz::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- pred pz_new_proc_id(pzp_id::out, pz::in, pz::out) is det.\n\n:- pred pz_add_proc(pzp_id::in, pz_proc::in, pz::in, pz::out) is det.\n\n:- func pz_get_procs(pz) = assoc_list(pzp_id, pz_proc).\n\n:- func pz_lookup_proc(pz, pzp_id) = pz_proc.\n\n:- func pz_get_num_procs(pz) = uint32.\n\n%-----------------------------------------------------------------------%\n\n:- pred pz_new_data_id(pzd_id::out, pz::in, pz::out) is det.\n\n:- pred pz_add_data(pzd_id::in, pz_data::in, pz::in, pz::out) is det.\n\n:- func pz_lookup_data(pz, pzd_id) = pz_data.\n\n:- func pz_get_data_items(pz) = assoc_list(pzd_id, pz_data).\n\n:- func pz_get_num_datas(pz) = uint32.\n\n%-----------------------------------------------------------------------%\n\n:- pred pz_new_closure_id(pzc_id::out, pz::in, pz::out) is det.\n\n:- pred pz_add_closure(pzc_id::in, pz_closure::in, pz::in, pz::out) is det.\n\n:- func pz_get_closures(pz) = assoc_list(pzc_id, pz_closure).\n\n:- func pz_get_num_closures(pz) = uint32.\n\n%-----------------------------------------------------------------------%\n\n:- func pz_get_exports(pz) = assoc_list(q_name, pzc_id) is det.\n\n:- pred pz_export_closure(pzc_id::in, q_name::in, pz::in, pz::out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module pair.\n:- import_module require.\n:- import_module uint32.\n\n%-----------------------------------------------------------------------%\n\n:- type pzs_id\n ---> pzs_id(pzs_id_num :: uint32).\n\npzs_id_get_num(pzs_id(Num)) = Num.\n\npzs_id_from_num(PZ, Num, pzs_id(Num)) :-\n Num < PZ ^ pz_next_struct_id ^ pzs_id_num.\n\n%-----------------------------------------------------------------------%\n\n:- type pzi_id\n ---> pzi_id(pzi_id_num :: uint32).\n\npzi_id_get_num(pzi_id(Num)) = Num.\n\npzi_id_from_num(PZ, Num, pzi_id(Num)) :-\n Num < PZ ^ pz_next_import_id ^ pzi_id_num.\n\n%-----------------------------------------------------------------------%\n\n:- type pzp_id\n ---> pzp_id(pzp_id_num :: uint32).\n\npzp_id_get_num(pzp_id(Num)) = Num.\n\npzp_id_from_num(PZ, Num, pzp_id(Num)) :-\n Num < PZ ^ pz_next_proc_id ^ pzp_id_num.\n\n%-----------------------------------------------------------------------%\n\n:- type pzd_id\n ---> pzd_id(pzd_id_num :: uint32).\n\npzd_id_get_num(pzd_id(Num)) = Num.\n\npzd_id_from_num(PZ, Num, pzd_id(Num)) :-\n Num < PZ ^ pz_next_data_id ^ pzd_id_num.\n\n%-----------------------------------------------------------------------%\n\n:- type pzc_id\n ---> pzc_id(pzc_id_num :: uint32).\n\npzc_id_get_num(pzc_id(Num)) = Num.\n\npzc_id_from_num(PZ, Num, pzc_id(Num)) :-\n Num < PZ ^ pz_next_closure_id ^ pzc_id_num.\n\n%-----------------------------------------------------------------------%\n\n:- type pz\n ---> pz(\n pz_module_names :: list(q_name),\n pz_file_type :: pz_file_type,\n\n pz_structs :: map(pzs_id, {string, maybe(pz_struct)}),\n pz_next_struct_id :: pzs_id,\n\n pz_imports :: map(pzi_id, pz_import),\n pz_next_import_id :: pzi_id,\n\n pz_procs :: map(pzp_id, pz_proc),\n pz_next_proc_id :: pzp_id,\n\n pz_data :: map(pzd_id, pz_data),\n pz_next_data_id :: pzd_id,\n\n pz_closures :: map(pzc_id, pz_closure_maybe_export),\n pz_next_closure_id :: pzc_id,\n pz_maybe_entry :: maybe(pz_entrypoint_internal),\n pz_entry_candidates :: set(pz_entrypoint_internal)\n ).\n\n:- type pz_closure_maybe_export\n ---> pz_closure(pz_closure)\n ; pz_exported_closure(q_name, pz_closure).\n\n:- type pz_entrypoint_internal\n ---> pz_entrypoint_internal(\n pz_epi_closure :: pzc_id,\n pz_epi_signature :: pz_entry_signature\n ).\n\n%-----------------------------------------------------------------------%\n\ninit_pz(ModuleNames, FileType) = pz(ModuleNames, FileType,\n init, pzs_id(0u32),\n init, pzi_id(0u32),\n init, pzp_id(0u32),\n init, pzd_id(0u32),\n init, pzc_id(0u32),\n no, init).\n\ninit_pz(ModuleNames, FileType, NumImports, NumStructs, NumDatas, NumProcs,\n NumClosures) =\n pz( ModuleNames, FileType,\n init, pzs_id(NumStructs),\n init, pzi_id(NumImports),\n init, pzp_id(NumProcs),\n init, pzd_id(NumDatas),\n init, pzc_id(NumClosures),\n no, init).\n\n%-----------------------------------------------------------------------%\n\npz_get_module_names(PZ) = PZ ^ pz_module_names.\n\npz_get_file_type(PZ) = PZ ^ pz_file_type.\n\n%-----------------------------------------------------------------------%\n\npz_set_entry_closure(Clo, Sig, !PZ) :-\n Entry = pz_entrypoint_internal(Clo, Sig),\n expect(unify(no, !.PZ ^ pz_maybe_entry), $file, $pred,\n \"Entry must be unset\"),\n expect(entry_is_exported(!.PZ, Entry), $file, $pred,\n \"Entry must be exported\"),\n !PZ ^ pz_maybe_entry := yes(Entry).\n\npz_get_maybe_entry_closure(PZ) =\n map_maybe(entrypoint_add_name(PZ), PZ ^ pz_maybe_entry).\n\npz_add_entry_candidate(Closure, Signature, !PZ) :-\n Entry = pz_entrypoint_internal(Closure, Signature),\n expect(entry_is_exported(!.PZ, Entry), $file, $pred,\n \"Entry must be exported\"),\n !PZ ^ pz_entry_candidates := insert(!.PZ ^ pz_entry_candidates, Entry).\n\npz_get_entry_candidates(PZ) =\n map(entrypoint_add_name(PZ), PZ ^ pz_entry_candidates).\n\n:- func get_name_of_export(pz, pzc_id) = q_name.\n\nget_name_of_export(PZ, Clo) = Name :-\n Exports = reverse_members(pz_get_exports(PZ)),\n lookup(Exports, Clo, Name).\n\n:- func entrypoint_add_name(pz, pz_entrypoint_internal) = pz_entrypoint.\n\nentrypoint_add_name(PZ, pz_entrypoint_internal(Clo, Sig)) =\n pz_entrypoint(Clo, Sig, get_name_of_export(PZ, Clo)).\n\n:- pred entry_is_exported(pz::in, pz_entrypoint_internal::in) is semidet.\n\nentry_is_exported(PZ, Entry) :-\n Closures = map(snd, pz_get_exports(PZ)),\n member(Entry ^ pz_epi_closure, Closures).\n\n%-----------------------------------------------------------------------%\n\npz_get_structs(PZ) = Structs :-\n filter_map(pred((K - {N, yes(S)})::in, (K - pz_named_struct(N, S))::out)\n is semidet,\n to_assoc_list(PZ ^ pz_structs), Structs).\n\npz_get_num_structs(PZ) = pzs_id_get_num(PZ ^ pz_next_struct_id).\n\npz_get_struct_names_map(PZ) = map_values(func(_, {N, _}) = N,\n PZ ^ pz_structs).\n\npz_lookup_struct(PZ, PZSId) = Struct :-\n {_, MaybeStruct} = map.lookup(PZ ^ pz_structs, PZSId),\n ( MaybeStruct = no,\n unexpected($file, $pred, \"Struct not found\")\n ; MaybeStruct = yes(Struct)\n ).\n\npz_new_struct_id(StructId, Name, !PZ) :-\n StructId = !.PZ ^ pz_next_struct_id,\n !PZ ^ pz_next_struct_id := pzs_id(StructId ^ pzs_id_num + 1u32),\n !PZ ^ pz_structs := det_insert(!.PZ ^ pz_structs, StructId, {Name, no}).\n\npz_add_struct(StructId, Struct, !PZ) :-\n Structs0 = !.PZ ^ pz_structs,\n ( if search(Structs0, StructId, {N, _}) then\n det_update(StructId, {N, yes(Struct)}, Structs0, Structs)\n else\n det_insert(StructId, {string(StructId), yes(Struct)}, Structs0, Structs)\n ),\n !PZ ^ pz_structs := Structs.\n\npz_add_struct(StructId, Name, Struct, !PZ) :-\n Structs0 = !.PZ ^ pz_structs,\n map.set(StructId, {Name, yes(Struct)}, Structs0, Structs),\n !PZ ^ pz_structs := Structs.\n\n%-----------------------------------------------------------------------%\n\npz_get_imports(PZ) = to_assoc_list(PZ ^ pz_imports).\n\npz_get_num_imports(PZ) = pzi_id_get_num(PZ ^ pz_next_import_id).\n\npz_lookup_import(PZ, ImportId) = lookup(PZ ^ pz_imports, ImportId).\n\npz_new_import(ImportId, Import, !PZ) :-\n ImportId = !.PZ ^ pz_next_import_id,\n !PZ ^ pz_next_import_id := pzi_id(ImportId ^ pzi_id_num + 1u32),\n pz_add_import(ImportId, Import, !PZ).\n\npz_add_import(ImportId, Import, !PZ) :-\n Imports0 = !.PZ ^ pz_imports,\n map.det_insert(ImportId, Import, Imports0, Imports),\n !PZ ^ pz_imports := Imports.\n\n%-----------------------------------------------------------------------%\n\npz_new_proc_id(ProcId, !PZ) :-\n ProcId = !.PZ ^ pz_next_proc_id,\n !PZ ^ pz_next_proc_id := pzp_id(ProcId ^ pzp_id_num + 1u32).\n\npz_add_proc(ProcID, Proc, !PZ) :-\n Procs0 = !.PZ ^ pz_procs,\n map.det_insert(ProcID, Proc, Procs0, Procs),\n !PZ ^ pz_procs := Procs.\n\npz_get_procs(PZ) = to_assoc_list(PZ ^ pz_procs).\n\npz_lookup_proc(PZ, PID) = map.lookup(PZ ^ pz_procs, PID).\n\npz_get_num_procs(PZ) = pzp_id_num(PZ ^ pz_next_proc_id).\n\n%-----------------------------------------------------------------------%\n\npz_new_data_id(NewID, !PZ) :-\n NewID = !.PZ ^ pz_next_data_id,\n !PZ ^ pz_next_data_id := pzd_id(NewID ^ pzd_id_num + 1u32).\n\npz_add_data(DataID, Data, !PZ) :-\n Datas0 = !.PZ ^ pz_data,\n map.det_insert(DataID, Data, Datas0, Datas),\n !PZ ^ pz_data := Datas.\n\npz_lookup_data(PZ, DataId) = Data :-\n lookup(PZ ^ pz_data, DataId, Data).\n\npz_get_data_items(PZ) = to_assoc_list(PZ ^ pz_data).\n\npz_get_num_datas(PZ) = pzd_id_num(PZ ^ pz_next_data_id).\n\n%-----------------------------------------------------------------------%\n\npz_new_closure_id(NewID, !PZ) :-\n NewID = !.PZ ^ pz_next_closure_id,\n !PZ ^ pz_next_closure_id := pzc_id(NewID ^ pzc_id_num + 1u32).\n\npz_add_closure(ClosureID, Closure, !PZ) :-\n Closures0 = !.PZ ^ pz_closures,\n map.det_insert(ClosureID, pz_closure(Closure), Closures0, Closures),\n !PZ ^ pz_closures := Closures.\n\npz_get_closures(PZ) =\n map((func(Id - CloEx) = Id - Clo :-\n ( CloEx = pz_closure(Clo)\n ; CloEx = pz_exported_closure(_, Clo)\n )\n ), to_assoc_list(PZ ^ pz_closures)).\n\npz_get_num_closures(PZ) = pzc_id_num(PZ ^ pz_next_closure_id).\n\n%-----------------------------------------------------------------------%\n\npz_get_exports(PZ) = Exports :-\n filter_map(is_export_closure, to_assoc_list(PZ ^ pz_closures), Exports).\n\npz_export_closure(Id, Name, !PZ) :-\n lookup(!.PZ ^ pz_closures, Id, ClosureExport0),\n ( ClosureExport0 = pz_closure(Closure),\n ClosureExport = pz_exported_closure(Name, Closure)\n ; ClosureExport0 = pz_exported_closure(_, _),\n unexpected($file, $pred, \"This closure is already exported\")\n ),\n set(Id, ClosureExport, !.PZ ^ pz_closures, Closures),\n !PZ ^ pz_closures := Closures.\n\n:- pred is_export_closure(pair(pzc_id, pz_closure_maybe_export)::in,\n pair(q_name, pzc_id)::out) is semidet.\n\nis_export_closure(Id - pz_exported_closure(Name, _), Name - Id).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pz.read.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pz.read.\n%\n% Read the PZ bytecode.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module maybe.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\n:- type pz_read_result\n ---> pz_read_result(pz_file_type, pz).\n\n:- pred read_pz(string::in, maybe_error(pz_read_result)::out,\n io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module require.\n:- import_module uint16.\n:- import_module uint32.\n:- import_module uint8.\n\n:- import_module common_types.\n:- import_module constant.\n:- import_module context.\n:- import_module int.\n:- import_module pz.bytecode.\n:- import_module pz.code.\n:- import_module pz.format.\n:- import_module pz.pz_ds.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.my_io.\n:- import_module util.mercury.\n:- import_module util.path.\n\n%-----------------------------------------------------------------------%\n\nread_pz(Filename, Result, !IO) :-\n open_binary_input(Filename, MaybeInput, !IO),\n ( MaybeInput = ok(Input),\n read_pz_2(Input, ResultPZ, !IO),\n ( ResultPZ = ok(ReadRes),\n Result = ok(ReadRes)\n ; ResultPZ = error(Error),\n Result = error(format(\"%s: %s\",\n [s(Filename), s(Error)]))\n ),\n close_binary_input(Input, !IO)\n ; MaybeInput = error(Error),\n Result = error(format(\"%s: %s\",\n [s(Filename), s(error_message(Error))]))\n ).\n\n:- pred read_pz_2(binary_input_stream::in, maybe_error(pz_read_result)::out,\n io::di, io::uo) is det.\n\nread_pz_2(Input, Result, !IO) :-\n my_io.read_uint32(Input, MaybeMagic, !IO),\n read_len_string(Input, MaybeObjectIdString, !IO),\n my_io.read_uint16(Input, MaybeVersion, !IO),\n MaybeHeader = combine_read_3(MaybeMagic, MaybeObjectIdString, MaybeVersion),\n ( MaybeHeader = ok({Magic, ObjectIdString, Version}),\n check_file_type(Magic, ObjectIdString, Version, ResultCheck),\n ( ResultCheck = ok(Type),\n read_options(Input, MaybeOptions, !IO),\n read_pz_3(Input, Type, MaybePZ0, !IO),\n MaybePZ1 = combine_read_2(MaybeOptions, MaybePZ0),\n ( MaybePZ1 = ok({Options, PZ1}),\n % An error during options processing cannot be detected\n % until here, after we read the rest of the module then\n % process the options.\n process_options(Options, PZ1, OptionsResult),\n ( OptionsResult = ok(PZ),\n Result = ok(pz_read_result(Type, PZ))\n ; OptionsResult = error(Error),\n Result = error(Error)\n )\n ; MaybePZ1 = error(Error),\n Result = error(Error)\n )\n ; ResultCheck = error(Error),\n Result = error(Error)\n )\n ; MaybeHeader = error(Error),\n Result = error(Error)\n ).\n\n:- pred check_file_type(uint32::in, string::in, uint16::in,\n maybe_error(pz_file_type)::out) is det.\n\ncheck_file_type(Magic, String, Version, Result) :-\n ( if\n % This has only one solution but Mercury can't figure it out.\n promise_equivalent_solutions [Type]\n (\n Magic = pz_object_magic,\n prefix(String, pz_object_id_string_part),\n Type = pzft_object\n ;\n Magic = pz_program_magic,\n prefix(String, pz_program_id_string_part),\n Type = pzft_program\n ;\n Magic = pz_library_magic,\n prefix(String, pz_library_id_string_part),\n Type = pzft_library\n )\n then\n ( if Version = pz_version then\n Result = ok(Type)\n else\n Result = error(format(\"Incorrect file verison, need %d got %d\",\n [i(to_int(pz_version)), i(to_int(Version))]))\n )\n else\n Result = error(\"Unrecognised file type\")\n ).\n\n:- type pz_options_entry\n ---> poe_entrypoint(uint32, pz_entry_signature, pz_entry_type).\n\n:- type pz_entry_type\n ---> entry_default\n ; entry_candidate.\n\n:- pred read_options(binary_input_stream::in,\n maybe_error(list(pz_options_entry))::out, io::di, io::uo)\n is det.\n\nread_options(Input, Result, !IO) :-\n my_io.read_uint16(Input, MaybeNumOptions, !IO),\n ( MaybeNumOptions = ok(NumOptions),\n % The file format currently only has one possible option, so just\n % read it if it's there.\n read_options_2(Input, to_int(NumOptions), [], Result, !IO)\n ; MaybeNumOptions = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_options_2(binary_input_stream::in, int::in,\n list(pz_options_entry)::in, maybe_error(list(pz_options_entry))::out,\n io::di, io::uo) is det.\n\nread_options_2(Input, Num, RevList0, Result, !IO) :-\n ( if Num > 0 then\n read_option_entry(Input, Result0, !IO),\n ( Result0 = ok(Entry),\n RevList = [Entry | RevList0],\n read_options_2(Input, Num - 1, RevList, Result, !IO)\n ; Result0 = error(Error),\n Result = error(Error)\n )\n else\n Result = ok(reverse(RevList0))\n ).\n\n:- pred read_option_entry(binary_input_stream::in,\n maybe_error(pz_options_entry)::out, io::di, io::uo) is det.\n\nread_option_entry(Input, Result, !IO) :-\n my_io.read_uint16(Input, MaybeType, !IO),\n my_io.read_uint16(Input, MaybeLen, !IO),\n MaybeTypeLen = combine_read_2(MaybeType, MaybeLen),\n ( MaybeTypeLen = ok({Type, Len}),\n ( if\n Type = pzf_opt_entry_closure,\n Len = 5u16\n then\n read_opt_entrypoint(Input, entry_default, Result, !IO)\n else if\n Type = pzf_opt_entry_candidate,\n Len = 5u16\n then\n read_opt_entrypoint(Input, entry_candidate, Result, !IO)\n else\n Result = error(\"Currupt option\")\n )\n ; MaybeTypeLen = error(Error),\n error(Error)\n ).\n\n:- pred read_opt_entrypoint(io.binary_input_stream::in, pz_entry_type::in,\n maybe_error(pz_options_entry)::out, io::di, io::uo) is det.\n\nread_opt_entrypoint(Input, Type, Result, !IO) :-\n my_io.read_uint8(Input, MaybeSignatureByte, !IO),\n my_io.read_uint32(Input, MaybeClosure, !IO),\n ReadRes = combine_read_2(MaybeSignatureByte, MaybeClosure),\n ( ReadRes = ok({SignatureByte, Closure}),\n ( if pz_signature_byte(Signature, SignatureByte) then\n Result = ok(poe_entrypoint(Closure, Signature, Type))\n else\n Result = error(\"Unrecognised entry signature byte\")\n )\n ; ReadRes = error(Error),\n Result = error(Error)\n ).\n\n:- pred process_options(list(pz_options_entry)::in, pz::in,\n maybe_error(pz)::out) is det.\n\nprocess_options([], PZ, ok(PZ)).\nprocess_options([Option | Options], !.PZ, Result) :-\n poe_entrypoint(EntryClo0, Signature, Type) = Option,\n ( if pzc_id_from_num(!.PZ, EntryClo0, EntryClo) then\n ( Type = entry_default,\n pz_set_entry_closure(EntryClo, Signature, !PZ)\n ; Type = entry_candidate,\n pz_add_entry_candidate(EntryClo, Signature, !PZ)\n ),\n process_options(Options, !.PZ, Result)\n else\n Result = error(\"Invalid closure ID for entry\")\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred read_pz_3(binary_input_stream::in, pz_file_type::in,\n maybe_error(pz)::out, io::di, io::uo) is det.\n\nread_pz_3(Input, FileType, Result, !IO) :-\n my_io.read_uint32(Input, MaybeNumModuleNames, !IO),\n ( MaybeNumModuleNames = ok(NumModuleNames),\n read_module_names(Input, NumModuleNames, [], MaybeModuleNames, !IO),\n my_io.read_uint32(Input, MaybeNumImports, !IO),\n my_io.read_uint32(Input, MaybeNumStructs, !IO),\n my_io.read_uint32(Input, MaybeNumDatas, !IO),\n my_io.read_uint32(Input, MaybeNumProcs, !IO),\n my_io.read_uint32(Input, MaybeNumClosures, !IO),\n my_io.read_uint32(Input, MaybeNumExports, !IO),\n MaybeNums = combine_read_7(MaybeModuleNames, MaybeNumImports,\n MaybeNumStructs, MaybeNumDatas, MaybeNumProcs, MaybeNumClosures,\n MaybeNumExports),\n (\n MaybeNums = ok({ModuleNames, NumImports, NumStructs, NumDatas,\n NumProcs, NumClosures, NumExports}),\n PZ = init_pz(ModuleNames, FileType, NumImports, NumStructs,\n NumDatas, NumProcs, NumClosures),\n read_pz_sections([read_imports(Input, NumImports),\n read_structs(Input, NumStructs),\n read_datas(Input, NumDatas),\n read_procs(Input, NumProcs),\n read_closures(Input, NumClosures),\n read_exports(Input, NumExports)],\n PZ, Result, !IO)\n ;\n MaybeNums = error(Error),\n Result = error(Error)\n )\n ; MaybeNumModuleNames = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_module_names(binary_input_stream::in, uint32::in,\n list(q_name)::in, maybe_error(list(q_name))::out, io::di, io::uo) is det.\n\nread_module_names(Input, Num, RevModuleNames, MaybeModuleNames, !IO) :-\n ( if Num > 0u32 then\n read_dotted_name(Input, MaybeName, !IO),\n ( MaybeName = ok(Name),\n read_module_names(Input, Num - 1u32, [Name | RevModuleNames],\n MaybeModuleNames, !IO)\n ; MaybeName = error(Error),\n MaybeModuleNames = error(Error)\n )\n else\n MaybeModuleNames = ok(reverse(RevModuleNames))\n ).\n\n:- pred read_pz_sections(\n list(pred(pz, maybe_error(pz), io, io)),\n pz, maybe_error(pz), io, io).\n:- mode read_pz_sections(\n in(list(pred(in, out, di, uo) is det)),\n in, out, di, uo) is det.\n\nread_pz_sections([], PZ, ok(PZ), !IO).\nread_pz_sections([Section | Sections], PZ0, Result, !IO) :-\n Section(PZ0, Result0, !IO),\n ( Result0 = ok(PZ),\n read_pz_sections(Sections, PZ, Result, !IO)\n ; Result0 = error(Error),\n Result = error(Error)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred read_imports(binary_input_stream::in, uint32::in,\n pz::in, maybe_error(pz)::out, io::di, io::uo) is det.\n\nread_imports(Input, Num, PZ0, Result, !IO) :-\n read_items(read_import(Input),\n (pred(N::in, I::in, PZI0::in, PZI::out) is det :-\n ( if pzi_id_from_num(PZI0, N, ImportId) then\n pz_add_import(ImportId, I, PZI0, PZI)\n else\n unexpected($file, $pred, \"Bad Import Id\")\n )\n ),\n Num, 0u32, PZ0, Result, !IO).\n\n:- pred read_import(binary_input_stream::in, T::in, maybe_error(pz_import)::out,\n io::di, io::uo) is det.\n\nread_import(Input, _, Result, !IO) :-\n read_uint8(Input, MaybeTypeByte, !IO),\n read_len_string(Input, MaybeModuleName, !IO),\n read_len_string(Input, MaybeSymbolName, !IO),\n MaybeReads = combine_read_3(MaybeTypeByte, MaybeModuleName,\n MaybeSymbolName),\n ( MaybeReads = ok({TypeByte, ModuleName, SymbolName}),\n ( if pz_import_type_byte(TypeP, TypeByte) then\n Type = TypeP\n else\n unexpected($file, $pred, \"Invalid import type\")\n ),\n Name = q_name_append_str(q_name_from_dotted_string_det(ModuleName),\n SymbolName),\n Result = ok(pz_import(Name, Type))\n ; MaybeReads = error(Error),\n Result = error(Error)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred read_structs(binary_input_stream::in, uint32::in,\n pz::in, maybe_error(pz)::out, io::di, io::uo) is det.\n\nread_structs(Input, Num, PZ0, Result, !IO) :-\n read_items(read_struct(Input),\n (pred(N::in, I::in, PZI0::in, PZI::out) is det :-\n ( if pzs_id_from_num(PZI0, N, StructId) then\n pz_add_struct(StructId, I, PZI0, PZI)\n else\n unexpected($file, $pred, \"Bad Struct Id\")\n )\n ),\n Num, 0u32, PZ0, Result, !IO).\n\n:- pred read_struct(binary_input_stream::in, T::in,\n maybe_error(pz_struct)::out, io::di, io::uo) is det.\n\nread_struct(Input, _, Result, !IO) :-\n read_uint32(Input, MaybeNumFields, !IO),\n ( MaybeNumFields = ok(NumFields0),\n NumFields = det_uint32_to_int(NumFields0),\n read_n(read_width(Input), NumFields, MaybeWidths, !IO),\n ( MaybeWidths = ok(Widths),\n Result = ok(pz_struct(Widths))\n ; MaybeWidths = error(Error),\n Result = error(Error)\n )\n ; MaybeNumFields = error(Error),\n Result = error(Error)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred read_datas(binary_input_stream::in, uint32::in,\n pz::in, maybe_error(pz)::out, io::di, io::uo) is det.\n\nread_datas(Input, Num, PZ0, Result, !IO) :-\n read_items(read_data(Input),\n (pred(N::in, I::in, PZI0::in, PZI::out) is det :-\n ( if pzd_id_from_num(PZI0, N, DataId) then\n pz_add_data(DataId, I, PZI0, PZI)\n else\n unexpected($file, $pred, \"Bad data id\")\n )\n ),\n Num, 0u32, PZ0, Result, !IO).\n\n:- pred read_data(binary_input_stream::in, pz::in, maybe_error(pz_data)::out,\n io::di, io::uo) is det.\n\nread_data(Input, PZ, Result, !IO) :-\n read_data_type(PZ, Input, TypeResult, !IO),\n ( TypeResult = ok(Type),\n (\n % XXX: Width is unused (#391).\n ( Type = type_array(_Width, Num)\n ; Type = type_string(Num),\n _Width = pzw_8\n ),\n read_data_enc(Input, EncResult, !IO),\n ( EncResult = ok({EncType, NumBytes}),\n read_n(read_data_value(PZ, Input, EncType, NumBytes),\n Num, ValuesResult, !IO)\n ; EncResult = error(Error0),\n ValuesResult = error(Error0)\n )\n ; Type = type_struct(StructId),\n pz_struct(Widths) = pz_lookup_struct(PZ, StructId),\n read_map(read_data_enc_value(PZ, Input), Widths, ValuesResult, !IO)\n ),\n ( ValuesResult = ok(Values),\n Result = ok(pz_data(Type, Values))\n ; ValuesResult = error(Error),\n Result = error(Error)\n )\n ; TypeResult = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_data_type(pz::in, binary_input_stream::in,\n maybe_error(pz_data_type)::out, io::di, io::uo) is det.\n\nread_data_type(PZ, Input, Result, !IO) :-\n read_uint8(Input, MaybeType, !IO),\n ( MaybeType = ok(Type),\n ( if Type = pzf_data_array then\n read_uint16(Input, MaybeNumItems, !IO),\n read_width(Input, MaybeWidth, !IO),\n Result0 = combine_read_2(MaybeNumItems, MaybeWidth),\n ( Result0 = ok({NumItems, Width}),\n Result = ok(type_array(Width, to_int(NumItems)))\n ; Result0 = error(Error),\n Result = error(Error)\n )\n else if Type = pzf_data_struct then\n read_struct_id(PZ, Input, MaybeStructId, !IO),\n Result = maybe_error_map(func(Id) = type_struct(Id),\n MaybeStructId)\n else if Type = pzf_data_string then\n read_uint16(Input, MaybeNumUnits, !IO),\n Result = maybe_error_map(func(NumUnits) =\n type_string(to_int(NumUnits)),\n MaybeNumUnits)\n else\n Result = error(\"Unknown data type\")\n )\n ; MaybeType = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_data_enc(binary_input_stream::in,\n maybe_error({enc_type, int})::out, io::di, io::uo) is det.\n\nread_data_enc(Input, Result, !IO) :-\n read_uint8(Input, MaybeEncByte, !IO),\n ( MaybeEncByte = ok(EncByte),\n ( if pz_enc_byte(EncType, NumBytes, EncByte) then\n Result = ok({EncType, NumBytes})\n else\n Result = error(\"Unknown encoding type/byte\")\n )\n ; MaybeEncByte = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_data_enc_value(pz::in, binary_input_stream::in,\n pz_width::in, maybe_error(pz_data_value)::out, io::di, io::uo) is det.\n\nread_data_enc_value(PZ, Input, _Width, Result, !IO) :-\n read_data_enc(Input, EncResult, !IO),\n ( EncResult = ok({EncType, NumBytes}),\n % TODO: We don't actually use the Width for how to read values.\n % That means this is another encoding inefficency (or unused\n % feature). (Bug #391)\n read_data_value(PZ, Input, EncType, NumBytes, Result, !IO)\n ; EncResult = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_data_value(pz::in, binary_input_stream::in,\n enc_type::in, int::in, maybe_error(pz_data_value)::out,\n io::di, io::uo) is det.\n\nread_data_value(_, Input, t_normal, NumBytes, Result, !IO) :-\n ( if NumBytes = 1 then\n read_uint8(Input, MaybeNum, !IO),\n Result = maybe_error_map(\n (func(N) = pzv_num(to_int(N))), MaybeNum)\n else if NumBytes = 2 then\n read_uint16(Input, MaybeNum, !IO),\n Result = maybe_error_map(\n (func(N) = pzv_num(to_int(N))), MaybeNum)\n else if NumBytes = 4 then\n read_uint32(Input, MaybeNum, !IO),\n Result = maybe_error_map(\n (func(N) = pzv_num(det_uint32_to_int(N))), MaybeNum)\n else if NumBytes = 8 then\n read_uint64(Input, MaybeNum, !IO),\n Result = maybe_error_map(\n (func(N) = pzv_num(det_uint64_to_int(N))), MaybeNum)\n else\n unexpected($file, $pred, \"Unknown encoding\")\n ).\nread_data_value(_, Input, t_wfast, NumBytes, Result, !IO) :-\n read_uint32(Input, MaybeNum, !IO),\n Result = maybe_error_map(\n (func(N) = pzv_num(det_uint32_to_int(N))), MaybeNum),\n expect(unify(NumBytes, 4), $file, $pred, \"Expected a 32bit value\").\nread_data_value(_, Input, t_wptr, NumBytes, Result, !IO) :-\n read_uint32(Input, MaybeNum, !IO),\n Result = maybe_error_map(\n (func(N) = pzv_num(det_uint32_to_int(N))), MaybeNum),\n expect(unify(NumBytes, 4), $file, $pred, \"Expected a 32bit value\").\nread_data_value(PZ, Input, t_data, NumBytes, Result, !IO) :-\n read_data_id(PZ, Input, MaybeDataId, !IO),\n Result = maybe_error_map(func(Id) = pzv_data(Id),\n MaybeDataId),\n expect(unify(NumBytes, 4), $file, $pred, \"Expected a 32bit value\").\nread_data_value(PZ, Input, t_closure, NumBytes, Result, !IO) :-\n read_closure_id(PZ, Input, MaybeClosureId, !IO),\n Result = maybe_error_map(func(Id) = pzv_closure(Id),\n MaybeClosureId),\n expect(unify(NumBytes, 4), $file, $pred, \"Expected a 32bit value\").\nread_data_value(PZ, Input, t_import, NumBytes, Result, !IO) :-\n read_import_id(PZ, Input, MaybeImportId, !IO),\n Result = maybe_error_map(func(Id) = pzv_import(Id),\n MaybeImportId),\n expect(unify(NumBytes, 4), $file, $pred, \"Expected a 32bit value\").\n\n%-----------------------------------------------------------------------%\n\n:- pred read_procs(binary_input_stream::in, uint32::in,\n pz::in, maybe_error(pz)::out, io::di, io::uo) is det.\n\nread_procs(Input, Num, PZ0, Result, !IO) :-\n read_items(read_proc(Input),\n (pred(N::in, I::in, PZI0::in, PZI::out) is det :-\n ( if pzp_id_from_num(PZI0, N, ProcId) then\n pz_add_proc(ProcId, I, PZI0, PZI)\n else\n unexpected($file, $pred, \"Bad Proc Id\")\n )\n ),\n Num, 0u32, PZ0, Result, !IO).\n\n:- pred read_proc(binary_input_stream::in, pz::in, maybe_error(pz_proc)::out,\n io::di, io::uo) is det.\n\nread_proc(Input, PZ, Result, !IO) :-\n read_dotted_name(Input, MaybeName, !IO),\n read_uint32(Input, MaybeNumBlocks, !IO),\n HeadResult = combine_read_2(MaybeName, MaybeNumBlocks),\n ( HeadResult = ok({Name, NumBlocks0}),\n NumBlocks = det_uint32_to_int(NumBlocks0),\n read_n(read_block(PZ, Input), NumBlocks, MaybeBlocks, !IO),\n ( MaybeBlocks = ok(Blocks),\n % XXX: This signature is fake.\n Signature = pz_signature([], []),\n Result = ok(pz_proc(Name, Signature, yes(Blocks)))\n ; MaybeBlocks = error(Error),\n Result = error(Error)\n )\n ; HeadResult = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_block(pz::in, binary_input_stream::in, maybe_error(pz_block)::out,\n io::di, io::uo) is det.\n\nread_block(PZ, Input, Result, !IO) :-\n read_uint32(Input, MaybeNumInstrObjs, !IO),\n ( MaybeNumInstrObjs = ok(NumInstrObjs0),\n NumInstrObjs = det_uint32_to_int(NumInstrObjs0),\n read_n(read_code_item(PZ, Input), NumInstrObjs, MaybeInstrObjs, !IO),\n Result = maybe_error_map((func(Is) = pz_block(Is)), MaybeInstrObjs)\n ; MaybeNumInstrObjs = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_code_item(pz::in, binary_input_stream::in,\n maybe_error(pz_instr_obj)::out, io::di, io::uo) is det.\n\nread_code_item(PZ, Input, Result, !IO) :-\n read_uint8(Input, TypeByteResult, !IO),\n ( TypeByteResult = ok(TypeByte),\n ( if code_entry_byte(Type, TypeByte) then\n ( Type = code_instr,\n read_instr(PZ, Input, Result, !IO)\n ;\n ( Type = code_meta_context\n ; Type = code_meta_context_short\n ; Type = code_meta_context_nil\n ),\n read_context(PZ, Input, Type, Result, !IO)\n )\n else\n Result = error(\"Invalid code entry type\")\n )\n ; TypeByteResult = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_instr(pz::in, binary_input_stream::in,\n maybe_error(pz_instr_obj)::out, io::di, io::uo) is det.\n\nread_instr(PZ, Input, Result, !IO) :-\n read_uint8(Input, OpcodeByteResult, !IO),\n ( OpcodeByteResult = ok(OpcodeByte),\n ( if opcode_byte(Opcode, OpcodeByte) then\n instruction_encoding(Opcode, WidthsNeeded, ImmediateNeeded),\n ( WidthsNeeded = no_width,\n MaybeWidths = ok(no_width)\n ; WidthsNeeded = one_width,\n read_width(Input, MaybeWidth, !IO),\n MaybeWidths = maybe_error_map(func(W) = one_width(W),\n MaybeWidth)\n ; WidthsNeeded = two_widths,\n read_width(Input, MaybeWidthA, !IO),\n read_width(Input, MaybeWidthB, !IO),\n MaybeWidths = maybe_error_map(\n func({A, B}) = two_widths(A, B),\n combine_read_2(MaybeWidthA, MaybeWidthB))\n ),\n read_immediate(PZ, Input, ImmediateNeeded, MaybeMaybeImmediate,\n !IO),\n MaybeWidthsImmediate = combine_read_2(MaybeWidths,\n MaybeMaybeImmediate),\n ( MaybeWidthsImmediate = ok({Widths, MaybeImmediate}),\n ( if instruction(Instr, Opcode, Widths, MaybeImmediate) then\n Result = ok(pzio_instr(Instr))\n else\n unexpected($file, $pred,\n \"Error in instruction encoding data for \" ++\n string(Opcode))\n )\n ; MaybeWidthsImmediate = error(Error),\n Result = error(Error)\n )\n else\n Result = error(\"Unknown opcode\")\n )\n ; OpcodeByteResult = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_immediate(pz::in, binary_input_stream::in, immediate_needed::in,\n maybe_error(maybe(pz_immediate_value))::out, io::di, io::uo) is det.\n\nread_immediate(_, _, im_none, ok(no), !IO).\nread_immediate(_, Input, im_num, Result, !IO) :-\n % XXX: The immediate value is always encoded as a 32 bit number but\n % this restriction should be lifted.\n read_int32(Input, MaybeInt, !IO),\n Result = maybe_error_map(func(N) = yes(pz_im_i32(N)), MaybeInt).\nread_immediate(PZ, Input, im_closure, Result, !IO) :-\n read_closure_id(PZ, Input, MaybeClosureId, !IO),\n Result = maybe_error_map(func(C) = yes(pz_im_closure(C)),\n MaybeClosureId).\nread_immediate(PZ, Input, im_proc, Result, !IO) :-\n read_proc_id(PZ, Input, MaybeProcId, !IO),\n Result = maybe_error_map(func(P) = yes(pz_im_proc(P)),\n MaybeProcId).\nread_immediate(PZ, Input, im_import, Result, !IO) :-\n read_import_id(PZ, Input, MaybeImportId, !IO),\n Result = maybe_error_map(func(I) = yes(pz_im_import(I)),\n MaybeImportId).\nread_immediate(PZ, Input, im_struct, Result, !IO) :-\n read_struct_id(PZ, Input, MaybeStructId, !IO),\n Result = maybe_error_map(func(S) = yes(pz_im_struct(S)),\n MaybeStructId).\nread_immediate(PZ, Input, im_struct_field, Result, !IO) :-\n read_struct_id(PZ, Input, MaybeStructId, !IO),\n read_uint8(Input, MaybeFieldNo, !IO),\n MaybeStructField = combine_read_2(MaybeStructId, MaybeFieldNo),\n Result = maybe_error_map(\n func({S, F}) = yes(pz_im_struct_field(S, field_num(to_int(F) + 1))),\n MaybeStructField).\nread_immediate(_, Input, im_label, Result, !IO) :-\n read_uint32(Input, MaybeInt, !IO),\n Result = maybe_error_map(func(L) = yes(pz_im_label(L)), MaybeInt).\nread_immediate(_, Input, im_depth, Result, !IO) :-\n read_uint8(Input, MaybeInt, !IO),\n Result = maybe_error_map(func(D) = yes(pz_im_depth(to_int(D))),\n MaybeInt).\n\n:- pred read_context(pz::in, binary_input_stream::in,\n code_entry_type::in(code_entry_type_context),\n maybe_error(pz_instr_obj)::out, io::di, io::uo) is det.\n\nread_context(PZ, Input, code_meta_context, Result, !IO) :-\n read_data_id(PZ, Input, MaybeDataId, !IO),\n read_uint32(Input, MaybeLine, !IO),\n MaybeContext = combine_read_2(MaybeDataId, MaybeLine),\n ( MaybeContext = ok({DataId, Line}),\n ( if data_get_filename(PZ, DataId, Filename0) then\n Filename = Filename0\n else\n unexpected($file, $pred, \"Bad filename in context information\")\n ),\n Context = context(Filename, det_uint32_to_int(Line)),\n Result = ok(pzio_context(pz_context(Context, DataId)))\n ; MaybeContext = error(Error),\n Result = error(Error)\n ).\n\nread_context(_, Input, code_meta_context_short, Result, !IO) :-\n read_uint32(Input, MaybeLine, !IO),\n Result = maybe_error_map(\n (func(I) = pzio_context(pz_context_short(det_uint32_to_int(I)))),\n MaybeLine).\nread_context(_, _Input, code_meta_context_nil, Result, !IO) :-\n Result = ok(pzio_context(pz_nil_context)).\n\n%-----------------------------------------------------------------------%\n\n:- pred read_closures(binary_input_stream::in, uint32::in,\n pz::in, maybe_error(pz)::out, io::di, io::uo) is det.\n\nread_closures(Input, Num, PZ0, Result, !IO) :-\n read_items(read_closure(Input),\n (pred(N::in, I::in, PZI0::in, PZI::out) is det :-\n ( if pzc_id_from_num(PZI0, N, ClosureId) then\n pz_add_closure(ClosureId, I, PZI0, PZI)\n else\n unexpected($file, $pred, \"Bad Closure Id\")\n )\n ),\n Num, 0u32, PZ0, Result, !IO).\n\n:- pred read_closure(binary_input_stream::in, pz::in,\n maybe_error(pz_closure)::out, io::di, io::uo) is det.\n\nread_closure(Input, PZ, Result, !IO) :-\n read_proc_id(PZ, Input, MaybeProc, !IO),\n read_data_id(PZ, Input, MaybeData, !IO),\n MaybePair = combine_read_2(MaybeProc, MaybeData),\n Result = maybe_error_map(\n func({Proc, Data}) = pz_closure(Proc, Data), MaybePair).\n\n%-----------------------------------------------------------------------%\n\n:- pred read_exports(binary_input_stream::in, uint32::in,\n pz::in, maybe_error(pz)::out, io::di, io::uo) is det.\n\nread_exports(Input, Num, PZ0, Result, !IO) :-\n read_items(read_export(Input),\n (pred(_::in, {Name, CloId}::in, PZI0::in, PZI::out) is det :-\n pz_export_closure(CloId, Name, PZI0, PZI)\n ),\n Num, 0u32, PZ0, Result, !IO).\n\n:- pred read_export(binary_input_stream::in, pz::in,\n maybe_error({q_name, pzc_id})::out, io::di, io::uo) is det.\n\nread_export(Input, PZ, Result, !IO) :-\n read_dotted_name(Input, MaybeName, !IO),\n read_uint32(Input, MaybeId, !IO),\n MaybePair = combine_read_2(MaybeName, MaybeId),\n Result = maybe_error_map(\n (func({Name, Num}) = {Name, Id} :-\n ( if pzc_id_from_num(PZ, Num, Id0) then\n Id = Id0\n else\n unexpected($file, $pred, \"Invalid closure id\")\n )\n ), MaybePair).\n\n%-----------------------------------------------------------------------%\n\n:- pred read_width(binary_input_stream::in, maybe_error(pz_width)::out,\n io::di, io::uo) is det.\n\nread_width(Input, Result, !IO) :-\n read_uint8(Input, MaybeByte, !IO),\n ( MaybeByte = ok(Byte),\n ( if pz_width_byte(Width, Byte) then\n Result = ok(Width)\n else\n Result = error(\"Invalid width\")\n )\n ; MaybeByte = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_struct_id(pz::in, binary_input_stream::in,\n maybe_error(pzs_id)::out, io::di, io::uo) is det.\n\nread_struct_id(PZ, Input, Result, !IO) :-\n read_uint32(Input, MaybeStructNum, !IO),\n ( MaybeStructNum = ok(StructNum),\n ( if pzs_id_from_num(PZ, StructNum, StructId) then\n Result = ok(StructId)\n else\n Result = error(\"Unknown struct\")\n )\n ; MaybeStructNum = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_data_id(pz::in, binary_input_stream::in,\n maybe_error(pzd_id)::out, io::di, io::uo) is det.\n\nread_data_id(PZ, Input, Result, !IO) :-\n read_uint32(Input, MaybeNum, !IO),\n ( MaybeNum = ok(Num),\n ( if pzd_id_from_num(PZ, Num, DataId) then\n Result = ok(DataId)\n else\n Result = error(\"Unknown data item\")\n )\n ; MaybeNum = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_proc_id(pz::in, binary_input_stream::in,\n maybe_error(pzp_id)::out, io::di, io::uo) is det.\n\nread_proc_id(PZ, Input, Result, !IO) :-\n read_uint32(Input, MaybeNum, !IO),\n ( MaybeNum = ok(Num),\n ( if pzp_id_from_num(PZ, Num, ProcId) then\n Result = ok(ProcId)\n else\n Result = error(\"Unknown procedure\")\n )\n ; MaybeNum = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_closure_id(pz::in, binary_input_stream::in,\n maybe_error(pzc_id)::out, io::di, io::uo) is det.\n\nread_closure_id(PZ, Input, Result, !IO) :-\n read_uint32(Input, MaybeNum, !IO),\n ( MaybeNum = ok(Num),\n ( if pzc_id_from_num(PZ, Num, ClosureId) then\n Result = ok(ClosureId)\n else\n Result = error(\"Unknown closure\")\n )\n ; MaybeNum = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_import_id(pz::in, binary_input_stream::in,\n maybe_error(pzi_id)::out, io::di, io::uo) is det.\n\nread_import_id(PZ, Input, Result, !IO) :-\n read_uint32(Input, MaybeNum, !IO),\n ( MaybeNum = ok(Num),\n ( if pzi_id_from_num(PZ, Num, ImportId) then\n Result = ok(ImportId)\n else\n Result = error(\"Unknown import\")\n )\n ; MaybeNum = error(Error),\n Result = error(Error)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred read_items(pred(pz, maybe_error(T), io, io), pred(uint32, T, pz, pz),\n uint32, uint32, pz, maybe_error(pz), io, io).\n:- mode read_items(pred(in, out, di, uo) is det, pred(in, in, in, out) is det,\n in, in, in, out, di, uo) is det.\n\nread_items(Read, Add, Num, Cur, PZ0, Result, !IO) :-\n ( if Cur < Num then\n Read(PZ0, Result0, !IO),\n ( Result0 = ok(Item),\n Add(Cur, Item, PZ0, PZ),\n read_items(Read, Add, Num, Cur + 1u32, PZ, Result, !IO)\n ; Result0 = error(Error),\n Result = error(Error)\n )\n else\n Result = ok(PZ0)\n ).\n\n:- pred read_n(pred(maybe_error(T), io, io), int, maybe_error(list(T)), io, io).\n:- mode read_n(pred(out, di, uo) is det, in, out, di, uo) is det.\n\nread_n(Pred, N, Result, !IO) :-\n ( if N > 0 then\n Pred(HeadResult, !IO),\n ( HeadResult = ok(Head),\n read_n(Pred, N - 1, Result0, !IO),\n ( Result0 = ok(Tail),\n Result = ok([Head | Tail])\n ; Result0 = error(Error),\n Result = error(Error)\n )\n ; HeadResult = error(Error),\n Result = error(Error)\n )\n else\n Result = ok([])\n ).\n\n:- pred read_map(pred(T, maybe_error(U), io, io),\n list(T), maybe_error(list(U)), io, io).\n:- mode read_map(pred(in, out, di, uo) is det,\n in, out, di, uo) is det.\n\nread_map(_, [], ok([]), !IO).\nread_map(Read, [X | Xs], Result, !IO) :-\n Read(X, ResultY, !IO),\n ( ResultY = ok(Y),\n read_map(Read, Xs, ResultYs, !IO),\n ( ResultYs = ok(Ys),\n Result = ok([Y | Ys])\n ; ResultYs = error(Error),\n Result = error(Error)\n )\n ; ResultY = error(Error),\n Result = error(Error)\n ).\n\n:- pred read_dotted_name(io.binary_input_stream::in,\n maybe_error(q_name)::out, io::di, io::uo) is det.\n\nread_dotted_name(Input, Result, !IO) :-\n read_len_string(Input, StringResult, !IO),\n ( StringResult = ok(String),\n Result = q_name_from_dotted_string(String)\n ; StringResult = error(Error),\n Result = error(Error)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred data_get_filename(pz::in, pzd_id::in, string::out) is semidet.\n\ndata_get_filename(PZ, DataId, String) :-\n Data = pz_lookup_data(PZ, DataId),\n pz_data(DataType, Items0) = Data,\n type_string(_NumItems) = DataType,\n % Drop the null byte at the end of the list.\n det_take(length(Items0) - 1, Items0, Items),\n map((pred(pzv_num(I)::in, C::out) is semidet :-\n from_int(I, C)\n ), Items, Chars),\n String = string.from_char_list(Chars).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pz.write.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pz.write.\n%\n% Write the PZ bytecode.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module maybe.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\n:- pred write_pz(string::in, pz::in, maybe_error::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module int.\n:- import_module int16.\n:- import_module int32.\n:- import_module int64.\n:- import_module int8.\n:- import_module list.\n:- import_module pair.\n:- import_module require.\n:- import_module set.\n:- import_module uint16.\n:- import_module uint32.\n:- import_module uint8.\n\n:- import_module common_types.\n:- import_module context.\n:- import_module pz.code.\n:- import_module pz.bytecode.\n:- import_module pz.format.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.my_io.\n\n%-----------------------------------------------------------------------%\n\nwrite_pz(Filename, PZ, Result, !IO) :-\n write_temp_and_move(open_binary_output, close_binary_output,\n write_pz_2(PZ), Filename, Result, !IO).\n\n:- pred write_pz_2(pz::in, binary_output_stream::in, maybe_error::out,\n io::di, io::uo) is det.\n\nwrite_pz_2(PZ, File, Result, !IO) :-\n FileType = pz_get_file_type(PZ),\n ( FileType = pzft_object,\n Magic = pz_object_magic,\n IdString = pz_object_id_string\n ; FileType = pzft_program,\n Magic = pz_program_magic,\n IdString = pz_program_id_string\n ; FileType = pzft_library,\n Magic = pz_library_magic,\n IdString = pz_library_id_string\n ),\n write_binary_uint32_le(File, Magic, !IO),\n write_len_string(File, IdString, !IO),\n write_binary_uint16_le(File, pz_version, !IO),\n write_pz_options(File, PZ, !IO),\n ModuleNames = pz_get_module_names(PZ),\n write_binary_uint32_le(File, det_from_int(length(ModuleNames)), !IO),\n foldl(write_module_name(File), ModuleNames, !IO),\n write_pz_entries(File, PZ, !IO),\n Result = ok.\n\n:- pred write_module_name(binary_output_stream::in, q_name::in,\n io::di, io::uo) is det.\n\nwrite_module_name(File, ModuleName, !IO) :-\n write_len_string(File, q_name_to_string(ModuleName), !IO).\n\n%-----------------------------------------------------------------------%\n\n:- pred write_pz_options(io.binary_output_stream::in, pz::in,\n io::di, io::uo) is det.\n\nwrite_pz_options(File, PZ, !IO) :-\n MaybeEntryClosure = pz_get_maybe_entry_closure(PZ),\n EntryCandidates = set.to_sorted_list(pz_get_entry_candidates(PZ)),\n NumOptions = length(EntryCandidates) +\n ( if MaybeEntryClosure = yes(_) then 1 else 0 ),\n\n write_binary_uint16_le(File, det_from_int(NumOptions), !IO),\n\n ( MaybeEntryClosure = yes(Entry),\n write_binary_uint16_le(File, pzf_opt_entry_closure, !IO),\n write_entrypoint(File, Entry, !IO)\n ; MaybeEntryClosure = no\n ),\n\n foldl(write_entry_candidate(File), EntryCandidates, !IO).\n\n:- pred write_entry_candidate(io.binary_output_stream::in,\n pz_entrypoint::in, io::di, io::uo) is det.\n\nwrite_entry_candidate(File, Entry, !IO) :-\n write_binary_uint16_le(File, pzf_opt_entry_candidate, !IO),\n write_entrypoint(File, Entry, !IO).\n\n:- pred write_entrypoint(io.binary_output_stream::in, pz_entrypoint::in,\n io::di, io::uo) is det.\n\nwrite_entrypoint(File, Entry, !IO) :-\n write_binary_uint16_le(File, 5u16, !IO),\n pz_entrypoint(EntryCID, Signature, _) = Entry,\n pz_signature_byte(Signature, SignatureByte),\n write_binary_uint8(File, SignatureByte, !IO),\n write_binary_uint32_le(File, pzc_id_get_num(EntryCID), !IO).\n\n:- pred write_pz_entries(io.binary_output_stream::in, pz::in, io::di, io::uo)\n is det.\n\nwrite_pz_entries(File, PZ, !IO) :-\n % Write counts of each entry type\n ImportedProcs = sort(pz_get_imports(PZ)),\n write_binary_uint32_le(File, det_from_int(length(ImportedProcs)), !IO),\n Structs = sort(pz_get_structs(PZ)),\n write_binary_uint32_le(File, det_from_int(length(Structs)), !IO),\n Datas = sort(pz_get_data_items(PZ)),\n write_binary_uint32_le(File, det_from_int(length(Datas)), !IO),\n Procs = sort(pz_get_procs(PZ)),\n write_binary_uint32_le(File, det_from_int(length(Procs)), !IO),\n Closures = sort(pz_get_closures(PZ)),\n write_binary_uint32_le(File, det_from_int(length(Closures)), !IO),\n Exports = pz_get_exports(PZ),\n write_binary_uint32_le(File, det_from_int(length(Exports)), !IO),\n\n % Write the actual entries.\n foldl(write_imported_proc(File), ImportedProcs, !IO),\n foldl(write_struct(File), Structs, !IO),\n foldl(write_data(File, PZ), Datas, !IO),\n foldl(write_proc(File), Procs, !IO),\n foldl(write_closure(File), Closures, !IO),\n foldl(write_export(File), Exports, !IO).\n\n%-----------------------------------------------------------------------%\n\n:- pred write_imported_proc(io.binary_output_stream::in,\n pair(T, pz_import)::in, io::di, io::uo) is det.\n\nwrite_imported_proc(File, _ - pz_import(QName, Type), !IO) :-\n q_name_parts(QName, MaybeModule, Proc),\n ( MaybeModule = yes(Module),\n pz_import_type_byte(Type, TypeByte),\n write_binary_uint8(File, TypeByte, !IO),\n ModuleName = q_name_to_string(Module),\n ProcName = nq_name_to_string(Proc),\n write_len_string(File, ModuleName, !IO),\n write_len_string(File, ProcName, !IO)\n ; MaybeModule = no,\n unexpected($file, $pred, \"Unqualified procedure name\")\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred write_struct(io.binary_output_stream::in,\n pair(T, pz_named_struct)::in, io::di, io::uo) is det.\n\nwrite_struct(File, _ - pz_named_struct(_, pz_struct(Widths)), !IO) :-\n write_binary_uint32_le(File, det_from_int(length(Widths)), !IO),\n foldl(write_width(File), Widths, !IO).\n\n:- pred write_width(io.binary_output_stream::in, pz_width::in,\n io::di, io::uo) is det.\n\nwrite_width(File, Width, !IO) :-\n pz_width_byte(Width, Int),\n write_binary_uint8(File, Int, !IO).\n\n%-----------------------------------------------------------------------%\n\n:- pred write_data(io.binary_output_stream::in, pz::in,\n pair(T, pz_data)::in, io::di, io::uo) is det.\n\nwrite_data(File, PZ, _ - pz_data(Type, Values), !IO) :-\n write_data_type(File, Type, !IO),\n write_data_values(File, PZ, Type, Values, !IO).\n\n:- pred write_data_type(io.binary_output_stream::in,\n pz_data_type::in, io::di, io::uo) is det.\n\nwrite_data_type(File, type_array(Width, Length), !IO) :-\n write_binary_uint8(File, pzf_data_array, !IO),\n write_binary_uint16_le(File, det_from_int(Length), !IO),\n write_width(File, Width, !IO).\nwrite_data_type(File, type_struct(PZSId), !IO) :-\n write_binary_uint8(File, pzf_data_struct, !IO),\n write_binary_uint32_le(File, pzs_id_get_num(PZSId), !IO).\nwrite_data_type(File, type_string(Length), !IO) :-\n write_binary_uint8(File, pzf_data_string, !IO),\n write_binary_uint16_le(File, det_from_int(Length), !IO).\n\n:- pred write_data_values(io.binary_output_stream::in, pz::in, pz_data_type::in,\n list(pz_data_value)::in, io::di, io::uo) is det.\n\nwrite_data_values(File, PZ, Type, Values, !IO) :-\n ( Type = type_array(Width, NumValues),\n ( if length(Values, NumValues) then\n true\n else\n unexpected($file, $pred, \"Incorrect array length\")\n ),\n write_enc_for_values(File, Width, Values, !IO),\n foldl(write_value(File, Width), Values, !IO)\n ; Type = type_struct(PZSId),\n pz_lookup_struct(PZ, PZSId) = pz_struct(Widths),\n foldl_corresponding(write_enc_value(File), Widths, Values, !IO)\n ; Type = type_string(NumUnits),\n ( if length(Values, NumUnits) then\n true\n else\n unexpected($file, $pred, \"Incorrect string length\")\n ),\n write_enc_for_values(File, pzw_8, Values, !IO),\n foldl(write_value(File, pzw_8), Values, !IO)\n ).\n\n:- pred write_enc_for_values(binary_output_stream::in, pz_width::in,\n list(pz_data_value)::in, io::di, io::uo) is det.\n\nwrite_enc_for_values(File, Width, Values, !IO) :-\n Encs = map(get_enc(Width), Values),\n ( Encs = [],\n EncType = t_normal,\n NumBytes = 1\n ; Encs = [Enc | _],\n expect(all_true(unify(Enc), Encs), $file, $pred,\n \"All elements must encode the same\"),\n Enc = {EncType, NumBytes}\n ),\n pz_enc_byte(EncType, NumBytes, EncByte),\n write_binary_uint8(File, EncByte, !IO).\n\n:- func get_enc(pz_width, pz_data_value) = {enc_type, int}.\n\nget_enc(Width, Value) = {EncType, NumBytes} :-\n value_enc(Value, Width, EncType, NumBytes).\n\n:- pred write_enc_value(io.binary_output_stream::in, pz_width::in,\n pz_data_value::in, io::di, io::uo) is det.\n\nwrite_enc_value(File, Width, Value, !IO) :-\n value_enc(Value, Width, EncType, NumBytes),\n pz_enc_byte(EncType, NumBytes, EncByte),\n write_binary_uint8(File, EncByte, !IO),\n write_value(File, Width, Value, !IO).\n\n:- pred value_enc(pz_data_value::in, pz_width::in, enc_type::out, int::out)\n is det.\n\nvalue_enc(pzv_num(_), pzw_8, t_normal, 1).\nvalue_enc(pzv_num(_), pzw_16, t_normal, 2).\nvalue_enc(pzv_num(_), pzw_32, t_normal, 4).\nvalue_enc(pzv_num(_), pzw_64, t_normal, 8).\nvalue_enc(pzv_num(_), pzw_fast, t_wfast, 4).\nvalue_enc(pzv_num(_), pzw_ptr, _, _) :-\n % This could be used by tag values in the future, currently I\n % think 32bit values are used.\n unexpected($file, $pred, \"Unused\").\nvalue_enc(Value, Width, Type, 4) :-\n ( Value = pzv_data(_),\n Type = t_data\n ; Value = pzv_import(_),\n Type = t_import\n ; Value = pzv_closure(_),\n Type = t_closure\n ),\n expect(unify(Width, pzw_ptr), $file, $pred, \"Must be pointer width\").\n\n:- pred write_value(io.binary_output_stream::in, pz_width::in,\n pz_data_value::in, io::di, io::uo) is det.\n\nwrite_value(File, pzw_8, pzv_num(Num), !IO) :-\n write_binary_int8(File, det_from_int(Num), !IO).\nwrite_value(File, pzw_16, pzv_num(Num), !IO) :-\n write_binary_int16_le(File, det_from_int(Num), !IO).\nwrite_value(File, pzw_32, pzv_num(Num), !IO) :-\n write_binary_int32_le(File, det_from_int(Num), !IO).\nwrite_value(File, pzw_64, pzv_num(Num), !IO) :-\n write_binary_int64_le(File, from_int(Num), !IO).\nwrite_value(File, pzw_fast, pzv_num(Num), !IO) :-\n write_binary_int32_le(File, det_from_int(Num), !IO).\nwrite_value(_, pzw_ptr, pzv_num(_), !IO) :-\n % This could be used by tag values in the future, currently I\n % think 32bit values are used.\n unexpected($file, $pred, \"Unused\").\nwrite_value(File, Width, Value, !IO) :-\n ( Value = pzv_data(DID),\n IdNum = pzd_id_get_num(DID)\n ; Value = pzv_import(IID),\n IdNum = pzi_id_get_num(IID)\n ; Value = pzv_closure(CID),\n IdNum = pzc_id_get_num(CID)\n ),\n write_binary_uint32_le(File, IdNum, !IO),\n expect(unify(Width, pzw_ptr), $file, $pred, \"Must be pointer width\").\n\n%-----------------------------------------------------------------------%\n\n:- pred write_proc(binary_output_stream::in, pair(T, pz_proc)::in,\n io::di, io::uo) is det.\n\nwrite_proc(File, _ - Proc, !IO) :-\n write_len_string(File, q_name_to_string(Proc ^ pzp_name), !IO),\n MaybeBlocks = Proc ^ pzp_blocks,\n ( MaybeBlocks = yes(Blocks),\n write_binary_uint32_le(File, det_from_int(length(Blocks)), !IO),\n foldl(write_block(File), Blocks, !IO)\n ; MaybeBlocks = no,\n unexpected($file, $pred, \"Missing definition\")\n ).\n\n:- pred write_block(binary_output_stream::in, pz_block::in,\n io::di, io::uo) is det.\n\nwrite_block(File, pz_block(Instr0), !IO) :-\n % Filter out the comments but leave everything else.\n filter_instrs(Instr0, pz_nil_context, [], Instrs),\n write_binary_uint32_le(File, det_from_int(length(Instrs)), !IO),\n foldl(write_instr(File), Instrs, !IO).\n\n:- pred filter_instrs(list(pz_instr_obj)::in, pz_context::in,\n list(pz_instr_obj)::in, list(pz_instr_obj)::out) is det.\n\nfilter_instrs([], _, !Instrs) :-\n reverse(!Instrs).\nfilter_instrs([I | Is0], PrevContext, !Instrs) :-\n ( I = pzio_instr(_),\n !:Instrs = [I | !.Instrs],\n NextContext = PrevContext\n ; I = pzio_comment(_),\n NextContext = PrevContext\n ; I = pzio_context(Context),\n ( if Context = PrevContext then\n true\n else if\n % If the filename is the same then we only need to store the\n % line number.\n Context = pz_context(context(File, Line, _), _),\n PrevContext = pz_context(context(File, _, _), _)\n then\n !:Instrs = [pzio_context(pz_context_short(Line)) | !.Instrs]\n else\n !:Instrs = [I | !.Instrs]\n ),\n NextContext = Context\n ),\n filter_instrs(Is0, NextContext, !Instrs).\n\n:- pred write_instr(binary_output_stream::in, pz_instr_obj::in,\n io::di, io::uo) is det.\n\nwrite_instr(File, pzio_instr(Instr), !IO) :-\n code_entry_byte(code_instr, CodeInstrByte),\n write_binary_uint8(File, CodeInstrByte, !IO),\n instruction(Instr, Opcode, Widths, MaybeImmediate),\n opcode_byte(Opcode, OpcodeByte),\n write_binary_uint8(File, OpcodeByte, !IO),\n ( Widths = no_width\n ; Widths = one_width(Width),\n write_width(File, Width, !IO)\n ; Widths = two_widths(WidthA, WidthB),\n write_width(File, WidthA, !IO),\n write_width(File, WidthB, !IO)\n ),\n ( MaybeImmediate = yes(Immediate),\n write_immediate(File, Immediate, !IO)\n ; MaybeImmediate = no\n ).\nwrite_instr(File, pzio_context(PZContext), !IO) :-\n ( PZContext = pz_context(Context, DataId),\n code_entry_byte(code_meta_context, CodeMetaByte),\n write_binary_uint8(File, CodeMetaByte, !IO),\n write_binary_uint32_le(File, pzd_id_get_num(DataId), !IO),\n write_binary_uint32_le(File, det_from_int(Context ^ c_line), !IO)\n ; PZContext = pz_context_short(Line),\n code_entry_byte(code_meta_context_short, CodeMetaByte),\n write_binary_uint8(File, CodeMetaByte, !IO),\n write_binary_uint32_le(File, det_from_int(Line), !IO)\n ; PZContext = pz_nil_context,\n code_entry_byte(code_meta_context_nil, CodeMetaByte),\n write_binary_uint8(File, CodeMetaByte, !IO)\n ).\nwrite_instr(_, pzio_comment(_), !IO) :-\n unexpected($file, $pred, \"pzio_comment\").\n\n:- pred write_immediate(binary_output_stream::in,\n pz_immediate_value::in, io::di, io::uo) is det.\n\nwrite_immediate(File, Immediate, !IO) :-\n ( Immediate = pz_im_i8(Int),\n write_binary_int8(File, Int, !IO)\n ; Immediate = pz_im_u8(Int),\n write_binary_uint8(File, Int, !IO)\n ; Immediate = pz_im_i16(Int),\n write_binary_int16_le(File, Int, !IO)\n ; Immediate = pz_im_u16(Int),\n write_binary_uint16_le(File, Int, !IO)\n ; Immediate = pz_im_i32(Int),\n write_binary_int32_le(File, Int, !IO)\n ; Immediate = pz_im_u32(Int),\n write_binary_uint32_le(File, Int, !IO)\n ; Immediate = pz_im_i64(Int),\n write_binary_int64_le(File, Int, !IO)\n ; Immediate = pz_im_u64(Int),\n write_binary_uint64_le(File, Int, !IO)\n ; Immediate = pz_im_label(Int),\n write_binary_uint32_le(File, Int, !IO)\n ; Immediate = pz_im_closure(ClosureId),\n write_binary_uint32_le(File, pzc_id_get_num(ClosureId), !IO)\n ; Immediate = pz_im_proc(ProcId),\n write_binary_uint32_le(File, pzp_id_get_num(ProcId), !IO)\n ; Immediate = pz_im_import(ImportId),\n write_binary_uint32_le(File, pzi_id_get_num(ImportId), !IO)\n ; Immediate = pz_im_struct(SID),\n write_binary_uint32_le(File, pzs_id_get_num(SID), !IO)\n ; Immediate = pz_im_struct_field(SID, field_num(FieldNumInt)),\n write_binary_uint32_le(File, pzs_id_get_num(SID), !IO),\n % Subtract 1 for the zero-based encoding format.\n write_binary_uint8(File, det_from_int(FieldNumInt - 1), !IO)\n ; Immediate = pz_im_depth(Int),\n write_binary_uint8(File, det_from_int(Int), !IO)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred write_closure(binary_output_stream::in,\n pair(T, pz_closure)::in, io::di, io::uo) is det.\n\nwrite_closure(File, _ - pz_closure(Proc, Data), !IO) :-\n write_binary_uint32_le(File, pzp_id_get_num(Proc), !IO),\n write_binary_uint32_le(File, pzd_id_get_num(Data), !IO).\n\n%-----------------------------------------------------------------------%\n\n:- pred write_export(binary_output_stream::in,\n pair(q_name, pzc_id)::in, io::di, io::uo) is det.\n\nwrite_export(File, Name - Id, !IO) :-\n write_len_string(File, q_name_to_string(Name), !IO),\n write_binary_uint32_le(File, pzc_id_get_num(Id), !IO).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/pzt_parse.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module pzt_parse.\n%\n% Parse the PZ textual representation.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n%-----------------------------------------------------------------------%\n\n:- import_module io.\n\n:- import_module asm_ast.\n:- import_module asm_error.\n:- import_module util.\n:- import_module util.result.\n\n:- pred parse(string::in, result(asm, asm_error)::out, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module cord.\n:- import_module list.\n:- import_module maybe.\n:- import_module require.\n:- import_module string.\n:- import_module unit.\n\n:- import_module common_types.\n:- import_module context.\n:- import_module lex.\n:- import_module parse_util.\n:- import_module parsing.\n:- import_module pz.\n:- import_module pz.code.\n:- import_module q_name.\n\n%-----------------------------------------------------------------------%\n\nparse(Filename, Result, !IO) :-\n parse_file(Filename, lexemes, ignore_tokens, parse_pzt, Result0, !IO),\n ( Result0 = ok(AST),\n Result = ok(AST)\n ; Result0 = errors(Errors),\n Result = errors(map(\n (func(error(C, E)) = error(C, e_read_src_error(E))), Errors))\n ).\n\n%-----------------------------------------------------------------------%\n\n:- type pzt_token == token(token_basic).\n\n:- type pzt_tokens == list(pzt_token).\n\n:- type token_basic\n ---> module_\n ; import\n ; export\n ; proc\n ; block\n ; struct\n ; data\n ; array\n ; string\n ; closure\n ; global_env\n ; entry\n ; jmp\n ; cjmp\n ; call\n ; tcall\n ; roll\n ; pick\n ; alloc\n ; make_closure\n ; load\n ; load_named\n ; store\n % TODO: we can probably remove the w_ptr token.\n ; w ; w8 ; w16 ; w32 ; w64 ; w_ptr ; ptr\n ; open_curly\n ; close_curly\n ; open_paren\n ; close_paren\n ; dash\n ; equals\n ; semicolon\n ; colon\n ; comma\n ; period\n ; identifier\n ; number\n ; comment\n ; whitespace\n ; eof.\n\n:- instance ident_parsing(token_basic) where [\n ident_ = identifier,\n period_ = period\n].\n\n:- func lexemes = list(lexeme(lex_token(token_basic))).\n\nlexemes = [\n (\"module\" -> return(module_)),\n (\"import\" -> return(import)),\n (\"export\" -> return(export)),\n (\"proc\" -> return(proc)),\n (\"block\" -> return(block)),\n (\"struct\" -> return(struct)),\n (\"data\" -> return(data)),\n (\"array\" -> return(array)),\n (\"string\" -> return(string)),\n (\"closure\" -> return(closure)),\n (\"global_env\" -> return(global_env)),\n (\"entry\" -> return(entry)),\n (\"jmp\" -> return(jmp)),\n (\"cjmp\" -> return(cjmp)),\n (\"call\" -> return(call)),\n (\"tcall\" -> return(tcall)),\n (\"roll\" -> return(roll)),\n (\"pick\" -> return(pick)),\n (\"alloc\" -> return(alloc)),\n (\"make_closure\" -> return(make_closure)),\n (\"load\" -> return(load)),\n (\"load_named\" -> return(load_named)),\n (\"store\" -> return(store)),\n (\"w\" -> return(w)),\n (\"w8\" -> return(w8)),\n (\"w16\" -> return(w16)),\n (\"w32\" -> return(w32)),\n (\"w64\" -> return(w64)),\n (\"w_ptr\" -> return(w_ptr)),\n (\"ptr\" -> return(ptr)),\n (\"{\" -> return(open_curly)),\n (\"}\" -> return(close_curly)),\n (\"(\" -> return(open_paren)),\n (\")\" -> return(close_paren)),\n (\"-\" -> return(dash)),\n (\"=\" -> return(equals)),\n (\",\" -> return(comma)),\n (\".\" -> return(period)),\n (\";\" -> return(semicolon)),\n (\":\" -> return(colon)),\n (lex.identifier -> return(identifier)),\n (?(\"-\") ++ lex.nat -> return(number)),\n (\"//\" ++ (*(anybut(\"\\n\")))\n -> return(comment)),\n (lex.whitespace -> return(whitespace))\n ].\n\n:- pred ignore_tokens(token_basic::in) is semidet.\n\nignore_tokens(whitespace).\nignore_tokens(comment).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- pred parse_pzt(pzt_tokens::in, result(asm, read_src_error)::out)\n is det.\n\nparse_pzt(Tokens, Result) :-\n parse_pzt_2(Tokens, Result0),\n ( Result0 = ok(Asm),\n Result = ok(Asm)\n ; Result0 = error(Ctxt, Got, Expect),\n Result = return_error(Ctxt, rse_parse_error(Got, Expect))\n ).\n\n:- pred parse_pzt_2(pzt_tokens::in, parse_res(asm)::out) is det.\n\nparse_pzt_2(!.Tokens, Result) :-\n parse_module_decl(ModuleDeclResult, !Tokens),\n ( ModuleDeclResult = ok(ModuleName),\n TokensBeforeItems = !.Tokens,\n zero_or_more_last_error(or([parse_import, parse_proc, parse_struct,\n parse_data, parse_closure, parse_entry]),\n ok(Items), LastError, !Tokens),\n ( !.Tokens = [],\n ( TokensBeforeItems = [FirstToken | _],\n Filename = FirstToken ^ t_context ^ c_file\n ; TokensBeforeItems = [],\n Filename = \"unknown.pzt\"\n ),\n Result = ok(asm(ModuleName, Filename, Items))\n ; !.Tokens = [token(_, Str, TokCtxt) | _],\n LastError = error(LECtxt, Got, Expect),\n ( if compare((<), LECtxt, TokCtxt) then\n Result = error(TokCtxt, Str, \"end of file\")\n else\n Result = error(LECtxt, Got, Expect)\n )\n )\n ; ModuleDeclResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_module_decl(parse_res(q_name)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_module_decl(Result, !Tokens) :-\n match_token(module_, MatchModule, !Tokens),\n parse_q_name(NameResult, !Tokens),\n match_token(semicolon, MatchSemicolon, !Tokens),\n ( if\n MatchModule = ok(_),\n NameResult = ok(Name),\n MatchSemicolon = ok(_)\n then\n Result = ok(Name)\n else\n Result = combine_errors_3(MatchModule, NameResult, MatchSemicolon)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred parse_struct(parse_res(asm_item)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_struct(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(struct, MatchStruct, !Tokens),\n ( MatchStruct = ok(_),\n parse_ident(IdentResult, !Tokens),\n within(open_curly, one_or_more(parse_width), close_curly,\n FieldsResult, !Tokens),\n match_token(semicolon, MatchSemi, !Tokens),\n ( if\n IdentResult = ok(Ident),\n FieldsResult = ok(Fields),\n MatchSemi = ok(_)\n then\n Result = ok(asm_item(q_name_single(Ident), Context,\n asm_struct(Fields)))\n else\n Result = combine_errors_3(IdentResult, FieldsResult, MatchSemi)\n )\n ; MatchStruct = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred parse_data(parse_res(asm_item)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_data(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(data, MatchData, !Tokens),\n parse_ident(IdentResult, !Tokens),\n match_token(equals, MatchEquals, !Tokens),\n parse_data_type(TypeResult, !Tokens),\n parse_data_values(ValuesResult, !Tokens),\n match_token(semicolon, MatchSemi, !Tokens),\n ( if\n MatchData = ok(_),\n IdentResult = ok(Ident),\n MatchEquals = ok(_),\n TypeResult = ok(Type),\n ValuesResult = ok(Values),\n MatchSemi = ok(_)\n then\n Result = ok(asm_item(q_name_single(Ident), Context,\n asm_data(Type, Values)))\n else\n Result = combine_errors_6(MatchData, IdentResult, MatchEquals,\n TypeResult, ValuesResult, MatchSemi)\n ).\n\n:- pred parse_data_type(parse_res(asm_data_type)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_data_type(Result, !Tokens) :-\n % Only arrays are implemented.\n or([parse_data_type_array,\n parse_data_type_struct,\n parse_data_type_string],\n Result, !Tokens).\n\n:- pred parse_data_type_array(parse_res(asm_data_type)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_data_type_array(Result, !Tokens) :-\n match_tokens([array, open_paren], StartMatch, !Tokens),\n parse_width(WidthResult, !Tokens),\n match_token(close_paren, CloseMatch, !Tokens),\n ( if\n StartMatch = ok(_),\n WidthResult = ok(Width),\n CloseMatch = ok(_)\n then\n Result = ok(asm_dtype_array(Width))\n else\n Result = combine_errors_3(StartMatch, WidthResult, CloseMatch)\n ).\n\n:- pred parse_data_type_struct(parse_res(asm_data_type)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_data_type_struct(Result, !Tokens) :-\n parse_ident(IdentResult, !Tokens),\n ( IdentResult = ok(Ident),\n Result = ok(asm_dtype_struct(Ident))\n ; IdentResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_data_type_string(parse_res(asm_data_type)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_data_type_string(Result, !Tokens) :-\n match_token(string, Result0, !Tokens),\n ( Result0 = ok(_),\n Result = ok(asm_dtype_string)\n ; Result0 = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_data_values(parse_res(list(asm_data_value))::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_data_values(Result, !Tokens) :-\n within(open_curly,\n zero_or_more(or([\n parse_data_value_num,\n parse_data_value_name])),\n close_curly, Result, !Tokens).\n\n:- pred parse_data_value_num(parse_res(asm_data_value)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_data_value_num(Result, !Tokens) :-\n parse_number(NumResult, !Tokens),\n Result = map((func(Num) = asm_dvalue_num(Num)), NumResult).\n\n:- pred parse_data_value_name(parse_res(asm_data_value)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_data_value_name(Result, !Tokens) :-\n parse_q_name(NameResult, !Tokens),\n Result = map((func(Name) = asm_dvalue_name(Name)), NameResult).\n\n%-----------------------------------------------------------------------%\n\n:- pred parse_closure(parse_res(asm_item)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_closure(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n optional(match_token(export), ok(MaybeExport), !Tokens),\n match_token(closure, ClosureMatch, !Tokens),\n parse_q_name(IdentResult, !Tokens),\n match_token(equals, EqualsMatch, !Tokens),\n parse_ident(ProcResult, !Tokens),\n parse_ident(DataResult, !Tokens),\n match_token(semicolon, SemicolonMatch, !Tokens),\n ( if\n ClosureMatch = ok(_),\n IdentResult = ok(Ident),\n EqualsMatch = ok(_),\n ProcResult = ok(Proc),\n DataResult = ok(Data),\n SemicolonMatch = ok(_)\n then\n ( MaybeExport = yes(_),\n Sharing = s_public\n ; MaybeExport = no,\n Sharing = s_private\n ),\n Closure = asm_closure(Proc, Data, Sharing),\n Result = ok(asm_item(Ident, Context, Closure))\n else\n Result = combine_errors_6(ClosureMatch, IdentResult, EqualsMatch,\n ProcResult, DataResult, SemicolonMatch)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred parse_entry(parse_res(asm_item)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_entry(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(entry, MatchEntry, !Tokens),\n parse_q_name(NameResult, !Tokens),\n match_token(semicolon, MatchSemicolon, !Tokens),\n ( if\n MatchEntry = ok(_),\n NameResult = ok(Name),\n MatchSemicolon = ok(_)\n then\n Result = ok(asm_entrypoint(Context, Name))\n else\n Result = combine_errors_3(MatchEntry, NameResult, MatchSemicolon)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred parse_import(parse_res(asm_item)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_import(Result, !Tokens) :-\n get_context(StartTokens, Context),\n StartTokens = !.Tokens,\n match_token(import, MatchImport, !Tokens),\n parse_q_name(QNameResult, !Tokens),\n parse_sig(SigResult, !Tokens),\n match_token(semicolon, MatchSemicolon, !Tokens),\n ( if\n MatchImport = ok(_),\n QNameResult = ok(QName),\n SigResult = ok(Sig),\n MatchSemicolon = ok(_)\n then\n Result = ok(asm_item(QName, Context, asm_import(Sig)))\n else\n !:Tokens = StartTokens,\n Result = combine_errors_4(MatchImport, QNameResult, SigResult,\n MatchSemicolon)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred parse_proc(parse_res(asm_item)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_proc(Result, !Tokens) :-\n get_context(StartTokens, Context),\n StartTokens = !.Tokens,\n match_token(proc, MatchProc, !Tokens),\n parse_q_name(QNameResult, !Tokens),\n parse_sig(SigResult, !Tokens),\n parse_body(BodyResult, !Tokens),\n match_token(semicolon, MatchSemicolon, !Tokens),\n ( if\n MatchProc = ok(_),\n QNameResult = ok(QName),\n SigResult = ok(Sig),\n BodyResult = ok(Body),\n MatchSemicolon = ok(_)\n then\n Result = ok(asm_item(QName, Context, asm_proc(Sig, Body)))\n else\n !:Tokens = StartTokens,\n Result = combine_errors_5(MatchProc, QNameResult, SigResult,\n BodyResult, MatchSemicolon)\n ).\n\n:- pred parse_sig(parse_res(pz_signature)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_sig(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(open_paren, MatchOpen, !Tokens),\n zero_or_more(parse_width, ok(Inputs), !Tokens),\n match_token(dash, MatchDash, !Tokens),\n zero_or_more(parse_width, ok(Outputs), !Tokens),\n match_token(close_paren, MatchClose, !Tokens),\n ( if\n MatchOpen = ok(_),\n MatchDash = ok(_),\n MatchClose = ok(_)\n then\n Result = ok(pz_signature(Inputs, Outputs))\n else\n Result = error(Context, \"malformed signature\", \"Inputs '-' Outputs\")\n ).\n\n:- pred parse_body(parse_res(list(pzt_block))::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_body(Result, !Tokens) :-\n within(open_curly, or([one_or_more(parse_block), parse_instrs]),\n close_curly, Result, !Tokens).\n\n:- pred parse_block(parse_res(pzt_block)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_block(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n match_token(block, MatchBlock, !Tokens),\n parse_ident(IdentResult, !Tokens),\n within(open_curly, zero_or_more(parse_instr), close_curly, InstrsResult,\n !Tokens),\n ( if\n MatchBlock = ok(_),\n IdentResult = ok(Ident),\n InstrsResult = ok(Instrs)\n then\n Result = ok(pzt_block(Ident, Instrs, Context))\n else\n Result = combine_errors_3(MatchBlock, IdentResult, InstrsResult)\n ).\n\n:- pred parse_instrs(parse_res(list(pzt_block))::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_instrs(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n one_or_more(parse_instr, InstrsResult, !Tokens),\n Result = map((func(Instrs) = [pzt_block(\"\", Instrs, Context)]),\n InstrsResult).\n\n:- pred parse_instr(parse_res(pzt_instruction)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_instr(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n parse_instr_code(Result0, !Tokens),\n optional(parse_full_width_suffix, ok(MaybeWidth), !Tokens),\n ( Result0 = ok(Code),\n ( MaybeWidth = no,\n Width = no\n ; MaybeWidth = yes({Width1, no}),\n Width = one_width(Width1)\n ; MaybeWidth = yes({Width1, yes(Width2)}),\n Width = two_widths(Width1, Width2)\n ),\n Result = ok(pzt_instruction(Code, Width, Context))\n ; Result0 = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_instr_code(parse_res(pzt_instruction_code)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_instr_code(Result, !Tokens) :-\n or([parse_ident_instr,\n parse_number_instr,\n parse_token_ident_instr(jmp, (func(Dest) = pzti_jmp(Dest))),\n parse_token_ident_instr(cjmp, (func(Dest) = pzti_cjmp(Dest))),\n parse_token_qname_instr(call, (func(Dest) = pzti_call(Dest))),\n parse_token_qname_instr(tcall, (func(Dest) = pzti_tcall(Dest))),\n parse_token_ident_instr(alloc, (func(Struct) = pzti_alloc(Struct))),\n parse_token_qname_instr(make_closure,\n (func(Proc) = pzti_make_closure(Proc))),\n parse_loadstore_instr,\n parse_imm_instr],\n Result, !Tokens).\n\n:- pred parse_ident_instr(parse_res(pzt_instruction_code)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_ident_instr(Result, !Tokens) :-\n parse_ident(Result0, !Tokens),\n Result = map((func(S) = pzti_word(S)), Result0).\n\n:- pred parse_number_instr(parse_res(pzt_instruction_code)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_number_instr(Result, !Tokens) :-\n parse_number(ResNumber, !Tokens),\n Result = map((func(N) = pzti_load_immediate(N)), ResNumber).\n\n:- pred parse_token_ident_instr(token_basic,\n func(string) = pzt_instruction_code,\n parse_res(pzt_instruction_code), pzt_tokens, pzt_tokens).\n:- mode parse_token_ident_instr(in, func(in) = (out) is det, out, in, out)\n is det.\n\nparse_token_ident_instr(Token, F, Result, !Tokens) :-\n parse_token_something_instr(Token, parse_ident, F, Result, !Tokens).\n\n:- pred parse_token_qname_instr(token_basic,\n func(q_name) = pzt_instruction_code,\n parse_res(pzt_instruction_code), pzt_tokens, pzt_tokens).\n:- mode parse_token_qname_instr(in, func(in) = (out) is det, out, in, out)\n is det.\n\nparse_token_qname_instr(Token, F, Result, !Tokens) :-\n parse_token_something_instr(Token, parse_q_name, F, Result, !Tokens).\n\n:- pred parse_token_something_instr(token_basic,\n pred(parse_res(T), pzt_tokens, pzt_tokens),\n func(T) = pzt_instruction_code,\n parse_res(pzt_instruction_code), pzt_tokens, pzt_tokens).\n:- mode parse_token_something_instr(in, pred(out, in, out) is det,\n func(in) = (out) is det, out, in, out) is det.\n\nparse_token_something_instr(Token, Parse, Convert, Result, !Tokens) :-\n match_token(Token, MatchToken, !Tokens),\n Parse(SomethingResult, !Tokens),\n ( if\n MatchToken = ok(_),\n SomethingResult = ok(Something)\n then\n Result = ok(Convert(Something))\n else\n Result = combine_errors_2(MatchToken, SomethingResult)\n ).\n\n:- pred parse_loadstore_instr(parse_res(pzt_instruction_code)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_loadstore_instr(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n next_token(\"instruction\", MatchInstr, !Tokens),\n ( MatchInstr = ok(token_and_string(Instr, InstrString)),\n ( if\n ( Instr = load\n ; Instr = store\n )\n then\n parse_ident(StructResult, !Tokens),\n parse_number(FieldNoResult, !Tokens),\n ( if\n StructResult = ok(Struct),\n FieldNoResult = ok(FieldNo)\n then\n ( Instr = load,\n Result = ok(pzti_load(Struct, field_num(FieldNo)))\n ; Instr = store,\n Result = ok(pzti_store(Struct, field_num(FieldNo)))\n )\n else\n Result = combine_errors_2(StructResult, FieldNoResult)\n )\n else\n Result = error(Context, InstrString, \"instruction\")\n )\n ; MatchInstr = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_imm_instr(parse_res(pzt_instruction_code)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_imm_instr(Result, !Tokens) :-\n next_token(\"instruction\", InstrResult, !Tokens),\n parse_number(ImmResult, !Tokens),\n ( if\n InstrResult = ok(token_and_string(Instr, _)),\n ImmResult = ok(Imm)\n then\n ( if Instr = roll then\n Result = ok(pzti_roll(Imm))\n else if Instr = pick then\n Result = ok(pzti_pick(Imm))\n else\n unexpected($file, $pred, \"instruction token\")\n )\n else\n Result = combine_errors_2(InstrResult, ImmResult)\n ).\n\n:- pred parse_full_width_suffix(parse_res({pz_width, maybe(pz_width)})::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_full_width_suffix(Result, !Tokens) :-\n parse_width_suffix(WidthResult, !Tokens),\n optional(parse_width_suffix, ok(MaybeWidth2), !Tokens),\n Result = map((func(W) = {W, MaybeWidth2}), WidthResult).\n\n:- pred parse_width_suffix(parse_res(pz_width)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_width_suffix(Result, !Tokens) :-\n match_token(colon, MatchColon, !Tokens),\n parse_width(Result0, !Tokens),\n ( MatchColon = ok(_),\n Result = Result0\n ; MatchColon = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred parse_width(parse_res(pz_width)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_width(Result, !Tokens) :-\n get_context(!.Tokens, Context),\n next_token(\"data width\", TokenResult, !Tokens),\n ( TokenResult = ok(token_and_string(Token, TokenString)),\n ( if token_is_width(Token, Width) then\n Result = ok(Width)\n else\n Result = error(Context, TokenString, \"data width\")\n )\n ; TokenResult = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_ident(parse_res(string)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_ident(Result, !Tokens) :-\n match_token(identifier, Result0, !Tokens),\n ( Result0 = ok(String),\n Result = ok(String)\n ; Result0 = error(C, G, E),\n Result = error(C, G, E)\n ).\n\n:- pred parse_number(parse_res(int)::out,\n pzt_tokens::in, pzt_tokens::out) is det.\n\nparse_number(Result, !Tokens) :-\n match_token(number, Result0, !Tokens),\n Result = map(det_to_int, Result0).\n\n%-----------------------------------------------------------------------%\n\n:- pred token_is_width(token_basic::in, pz_width::out) is semidet.\n\ntoken_is_width(w, pzw_fast).\ntoken_is_width(w8, pzw_8).\ntoken_is_width(w16, pzw_16).\ntoken_is_width(w32, pzw_32).\ntoken_is_width(w64, pzw_64).\ntoken_is_width(w_ptr, pzw_ptr).\ntoken_is_width(ptr, pzw_ptr).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/q_name.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module q_name.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Qualified name ADT\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module list.\n:- import_module maybe.\n\n:- import_module util.\n:- import_module util.pretty.\n\n%-----------------------------------------------------------------------%\n\n % Qualified name.\n %\n:- type q_name.\n\n:- func q_name(nq_name) = q_name.\n:- func q_name_single(string) = q_name.\n\n:- func q_name_from_dotted_string(string) = maybe_error(q_name).\n\n:- func q_name_from_dotted_string_det(string) = q_name.\n\n % Throws an exception if the strings can't be made into nq_names.\n %\n:- func q_name_from_strings(list(string)) = q_name.\n\n % This helps the parser avoid an inefficiency, the first argument is for\n % the module parts and the second for the symbol itself.\n %\n:- func q_name_from_strings_2(list(string), string) = q_name.\n\n:- func q_name_to_string(q_name) = string.\n\n % Provide a clobbered version of this string suitable as a C++\n % identifier.\n:- func q_name_clobber(q_name) = string.\n\n:- pred q_name_parts(q_name, maybe(q_name), nq_name).\n:- mode q_name_parts(in, out, out) is det.\n\n % True of the qualified name is just an occurance of a simple name,\n % eg: it could be a variable name.\n %\n:- pred q_name_is_single(q_name::in, string::out) is semidet.\n\n % Throws an exception if the string can't be made into nq_names.\n %\n:- func q_name_append_str(q_name, string) = q_name.\n\n:- pred q_name_append(q_name, nq_name, q_name).\n:- mode q_name_append(in, in, out) is det.\n:- mode q_name_append(in, out, in) is semidet.\n\n:- func q_name_append(q_name, nq_name) = q_name.\n\n % Return the unqualified part of the name (stripping the module\n % qualifiers away).\n %\n:- func q_name_unqual(q_name) = nq_name.\n\n%-----------------------------------------------------------------------%\n\n % Non-qualified name.\n %\n % This is an abstract type over a string, but it ensures that the string\n % is a legal identifier.\n %\n:- type nq_name.\n\n:- func nq_name_det(string) = nq_name.\n\n:- func nq_name_from_string(string) = maybe_error(nq_name).\n\n:- func nq_name_to_string(nq_name) = string.\n\n%-----------------------------------------------------------------------%\n\n:- func q_name_pretty(q_name) = pretty.\n\n % q_name_pretty_relative(Module, Name) = Pretty.\n %\n % Print a shortened version of the name if it's in the module Module.\n % If it's outside this module then print it normally.\n %\n:- func q_name_pretty_relative(q_name, q_name) = pretty.\n\n:- func nq_name_pretty(nq_name) = pretty.\n\n%-----------------------------------------------------------------------%\n\n:- type nq_named(E)\n ---> nq_named(nq_name, E).\n\n:- type q_named(T)\n ---> q_named(q_name, T).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module require.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\n:- type q_name\n ---> unqualified(nq_name)\n ; qualified(q_name, nq_name).\n\nq_name(Name) = unqualified(Name).\nq_name_single(Name) = unqualified(nq_name(Name)).\n\nq_name_from_dotted_string(Dotted) = MaybeName :-\n Parts0 = map(nq_name_from_string, split_at_char('.', Dotted)),\n ( if\n map(pred(ok(P)::in, P::out) is semidet,\n Parts0, Parts)\n then\n MaybeName = ok(q_name_from_list(Parts))\n else if\n find_first_match(pred(error(_)::in) is semidet, Parts0, FirstError),\n FirstError = error(E)\n then\n MaybeName = error(E)\n else\n unexpected($file, $pred, \"Couldn't find error\")\n ).\n\nq_name_from_dotted_string_det(Dotted) = Name :-\n MaybeName = q_name_from_dotted_string(Dotted),\n ( MaybeName = ok(Name)\n ; MaybeName = error(Error),\n unexpected($file, $pred, Error)\n ).\n\nq_name_from_strings(Strings) = q_name_from_list(map(nq_name_det, Strings)).\n\nq_name_from_strings_2(Module, Symbol) =\n q_name_from_list_2(map(nq_name_det, Module), nq_name_det(Symbol)).\n\nq_name_to_string(QName) = String :-\n q_name_break(QName, Quals, Name),\n ( Quals = [_ | _],\n String = join_list(\".\", map(nq_name_to_string, Quals)) ++ \".\" ++\n nq_name_to_string(Name)\n ; Quals = [],\n String = nq_name_to_string(Name)\n ).\n\nq_name_clobber(QName) = String :-\n q_name_break(QName, Quals, Name),\n ( Quals = [_ | _],\n String = join_list(\"_\", map(nq_name_to_string, Quals)) ++ \"_\" ++\n nq_name_to_string(Name)\n ; Quals = [],\n String = nq_name_to_string(Name)\n ).\n\nq_name_parts(QName, MaybeModule, Symbol) :-\n q_name_break(QName, ModuleParts, Symbol),\n ( ModuleParts = [],\n MaybeModule = no\n ; ModuleParts = [_ | _],\n MaybeModule = yes(q_name_from_list(ModuleParts))\n ).\n\nq_name_is_single(QName, nq_name_to_string(NQName)) :-\n q_name_break(QName, [], NQName).\n\nq_name_append_str(ModuleSym, Name) = QName :-\n q_name_append(ModuleSym, nq_name_det(Name), QName).\n\nq_name_append(A, B, R) :-\n q_name_break(A, AMods, AName),\n Mods = q_name_from_list_2(AMods, AName),\n R = qualified(Mods, B).\n\nq_name_append(A, B) = R :-\n q_name_append(A, B, R).\n\nq_name_unqual(unqualified(NQName)) = NQName.\nq_name_unqual(qualified(_, NQName)) = NQName.\n\n%-----------------------------------------------------------------------%\n\n:- func q_name_from_list(list(nq_name)) = q_name.\n\nq_name_from_list(List) = QName :-\n det_split_last(List, Qualifiers, Name),\n QName = q_name_from_list_2(Qualifiers, Name).\n\n:- func q_name_from_list_2(list(nq_name), nq_name) = q_name.\n\nq_name_from_list_2([], Name) = unqualified(Name).\nq_name_from_list_2(Quals@[_ | _], Name) =\n qualified(q_name_from_list(Quals), Name).\n\n % Break up a q_name into parts.\n %\n:- pred q_name_break(q_name::in, list(nq_name)::out, nq_name::out) is det.\n\nq_name_break(unqualified(Name), [], Name).\nq_name_break(qualified(Modules0, Name), Modules, Name) :-\n Modules = reverse(q_name_break_2(Modules0)).\n\n:- func q_name_break_2(q_name) = list(nq_name).\n\nq_name_break_2(unqualified(Name)) = [Name].\nq_name_break_2(qualified(Module, Name)) = [Name | q_name_break_2(Module)].\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- type nq_name\n ---> nq_name(string).\n\nnq_name_det(String) = Name :-\n Check = nq_name_from_string(String),\n ( Check = ok(Name)\n ; Check = error(Error),\n unexpected($file, $pred, Error)\n ).\n\nnq_name_from_string(String) = MaybeName :-\n ( if not is_all_alnum_or_underscore(String) then\n MaybeName = error(\"Illegal identifier\")\n else if length(String) = 0 then\n MaybeName = error(\"Empty identifier\")\n else\n MaybeName = ok(nq_name(String))\n ).\n\nnq_name_to_string(nq_name(String)) = String.\n\n%-----------------------------------------------------------------------%\n\nq_name_pretty(Name) = p_str(q_name_to_string(Name)).\n\nq_name_pretty_relative(Module, Name) = Pretty :-\n ( if q_name_append(Module, UnqualName, Name) then\n Pretty = nq_name_pretty(UnqualName)\n else\n Pretty = q_name_pretty(Name)\n ).\n\nnq_name_pretty(Name) = p_str(nq_name_to_string(Name)).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/toml.m", "content": "%-----------------------------------------------------------------------%\n% Plasma builder\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This library parses a reduced version of toml syntax.\n%\n%-----------------------------------------------------------------------%\n:- module toml.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module list.\n:- import_module map.\n:- import_module pair.\n\n:- import_module context.\n:- import_module util.\n:- import_module util.result.\n\n%-----------------------------------------------------------------------%\n\n:- type toml == map(toml_key, pair(toml_value, context)).\n\n:- type toml_key == string.\n:- type toml_value\n ---> tv_string(string)\n ; tv_array(list(toml_value))\n ; tv_table(toml).\n\n:- pred parse_toml(input_stream::in, string::in, result(toml, string)::out,\n io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module int.\n:- import_module string.\n\n:- import_module util.my_exception.\n\n%-----------------------------------------------------------------------%\n\nparse_toml(Stream, Filename, Result, !IO) :-\n parse_lines(Stream, Filename, 1, no_table, init, Result, !IO).\n\n:- type parse_table\n ---> no_table\n ; table(\n pt_context :: context,\n pt_name :: string,\n pt_map :: toml\n ).\n\n:- pred parse_lines(input_stream::in, string::in, int::in, parse_table::in,\n toml::in, result(toml, string)::out, io::di, io::uo) is det.\n\nparse_lines(Stream, Filename, LineNum, !.Table, !.Toml, Result, !IO) :-\n Context = context(Filename, LineNum),\n read_line_as_string(Stream, LineRes, !IO),\n ( LineRes = ok(Line0),\n Line = strip(strip_comment(Line0)),\n ( if\n Line = \"\"\n then\n parse_lines(Stream, Filename, LineNum + 1, !.Table,\n !.Toml, Result, !IO)\n else if\n % The beginning of a table.\n remove_prefix(\"[\", Line, Name0),\n remove_suffix(Name0, \"]\", Name)\n then\n end_table(!.Table, !.Toml, Result0),\n ( Result0 = ok(!:Toml),\n parse_lines(Stream, Filename, LineNum + 1,\n table(Context, strip(Name), init), !.Toml, Result, !IO)\n ; Result0 = errors(_),\n Result = Result0\n )\n else if\n [LHS, RHS] = split_at_char('=', Line),\n LHS \\= \"\",\n RHS \\= \"\"\n then\n Value = parse_value(strip(RHS)),\n ( if toml_insert(strip(LHS), Value, Context, !Table, !Toml) then\n parse_lines(Stream, Filename, LineNum + 1, !.Table,\n !.Toml, Result, !IO)\n else\n Result = return_error(Context,\n format(\"Duplicate key `%s`\", [s(strip(LHS))]))\n )\n else\n Result = return_error(Context, \"Unrecognised TOML line\")\n )\n ; LineRes = eof,\n end_table(!.Table, !.Toml, Result)\n ; LineRes = error(Error),\n Result = return_error(context(Filename), error_message(Error))\n ).\n\n:- pred toml_insert(toml_key::in, toml_value::in, context::in,\n parse_table::in, parse_table::out, toml::in, toml::out) is semidet.\n\ntoml_insert(Key, Value, Context, no_table, no_table, !Toml) :-\n insert(Key, Value - Context, !Toml).\ntoml_insert(Key, Value, Context, !Table, !Toml) :-\n insert(Key, Value - Context, !.Table ^ pt_map, Map),\n !Table ^ pt_map := Map.\n\n:- pred end_table(parse_table::in, toml::in,\n result(toml, string)::out) is det.\n\nend_table(no_table, Toml, ok(Toml)).\nend_table(table(Context, Name, Table), !.Toml, Result) :-\n ( if insert(Name, tv_table(Table) - Context, !Toml) then\n Result = ok(!.Toml)\n else\n Result = return_error(Context, \"Duplicate table: \" ++ Name)\n ).\n\n:- func strip_comment(string) = string.\n\nstrip_comment(Line) =\n left(Line, prefix_length(\n pred(C::in) is semidet :- C \\= '#', Line)).\n\n:- func parse_value(string) = toml_value.\n\nparse_value(String) = Value :-\n ( if\n append(\"[\", Rest0, String),\n append(Rest, \"]\", Rest0)\n then\n ( if contains_char(Rest, '[') then\n % We actually need a proper parser here to do nested structures.\n % So we don't support nested lists.\n my_exception.sorry($file, $pred,\n \"Nested arrays\")\n else\n Value = tv_array(map(parse_value, map(strip,\n split_at_char(',', Rest))))\n )\n else\n Value = tv_string(String)\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.log.m", "content": "%-----------------------------------------------------------------------%\n% Logging code\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module util.log.\n\n:- interface.\n\n:- import_module io.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\n % The desired logging level.\n %\n:- type log_config\n ---> silent\n ; verbose.\n\n:- pred verbose_output(log_config::in, string::in, io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n%-----------------------------------------------------------------------%\n\nverbose_output(silent, _, !IO).\nverbose_output(verbose, Message, !IO) :-\n io.write_string(Message, !IO).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.m", "content": "%-----------------------------------------------------------------------%\n% Utility code\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module util.\n\n:- interface.\n\n:- include_module util.my_exception.\n:- include_module util.my_io.\n:- include_module util.log.\n:- include_module util.mercury.\n:- include_module util.path.\n:- include_module util.pretty.\n:- include_module util.pretty_old.\n:- include_module util.result.\n:- include_module util.my_string.\n:- include_module util.my_time.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.mercury.m", "content": "%-----------------------------------------------------------------------%\n% Mercury Utility code\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module util.mercury.\n\n:- interface.\n\n:- import_module bag.\n:- import_module cord.\n:- import_module getopt.\n:- import_module io.\n:- import_module list.\n:- import_module map.\n:- import_module maybe.\n:- import_module pair.\n:- import_module set.\n\n%-----------------------------------------------------------------------%\n\n % Print the error to stderror and set the exit code to 1.\n %\n % Does not terminate the program.\n %\n:- pred exit_error(string::in, io::di, io::uo) is det.\n\n:- func curry(func(A, B) = C, pair(A, B)) = C.\n\n % one_item([X]) = X.\n %\n:- func one_item(list(T)) = T.\n\n:- func one_item_in_set(set(T)) = T.\n\n:- func first_item(list(T)) = T.\n\n:- func maybe_list(maybe(X)) = list(X).\n\n:- func list_maybe_to_list(list(maybe(X))) = list(X).\n\n:- func maybe_cord(maybe(X)) = cord(X).\n\n % find_duplicates(List, DupsInList),\n %\n % DupsInList is the set of duplicate items in List, if DupsInList is\n % empty, then List contains no duplicates.\n %\n:- pred find_duplicates(list(X)::in, set(X)::out) is det.\n\n % Mercury does not provide a map over maybe_error.\n %\n:- func maybe_error_map(func(A) = B, maybe_error(A, E)) = maybe_error(B, E).\n\n:- func maybe_error_list(list(maybe_error(A, E))) =\n maybe_error(list(A), list(E)).\n\n % set_map_foldl2(Pred, Set0, Set, !Acc1, !Acc2),\n %\n:- pred set_map_foldl2(pred(X, Y, A, A, B, B),\n set(X), set(Y), A, A, B, B).\n:- mode set_map_foldl2(pred(in, out, in, out, in, out) is det,\n in, out, in, out, in, out) is det.\n\n:- pred map2_corresponding(pred(X, Y, A, B), list(X), list(Y), list(A),\n list(B)).\n:- mode map2_corresponding(pred(in, in, out, out) is det, in, in, out, out)\n is det.\n\n:- pred map4_corresponding2(pred(A, B, C, D, X, Y), list(A), list(B),\n list(C), list(D), list(X), list(Y)).\n:- mode map4_corresponding2(pred(in, in, in, in, out, out) is det, in, in,\n in, in, out, out) is det.\n\n:- pred remove_first_match_map(pred(X, Y), Y, list(X), list(X)).\n:- mode remove_first_match_map(pred(in, out) is semidet, out, in, out)\n is semidet.\n\n % det_uint32_to_int\n %\n % For some reason Mercury 20.01 doesn't provide this (it would be\n % uint32.det_to_int).\n %\n:- func det_uint32_to_int(uint32) = int.\n\n:- func det_uint64_to_int(uint64) = int.\n\n%-----------------------------------------------------------------------%\n\n:- func list_join(list(T), list(T)) = list(T).\n\n:- func bag_list_to_bag(list(bag(T))) = bag(T).\n\n:- func string_join(string, list(string)) = string.\n\n % delete_first_match(L1, Pred, L) :-\n %\n % L is L1 with the first element that satisfies Pred removed, it fails\n % if there is no element satisfying Pred.\n %\n:- pred list_delete_first_match(list(T), pred(T), list(T)).\n:- mode list_delete_first_match(in, pred(in) is semidet, out) is semidet.\n\n%-----------------------------------------------------------------------%\n\n:- func power_intersect_list(list(set(T))) = set(T).\n\n%-----------------------------------------------------------------------%\n\n:- func handle_bool_option(option_table(O), O, T, T) = T.\n\n%-----------------------------------------------------------------------%\n\n:- pred map_set_or_update(func(V) = V, K, V, map(K, V), map(K, V)).\n:- mode map_set_or_update(in, in, in, in, out) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module bool.\n:- import_module require.\n:- import_module string.\n:- import_module uint32.\n:- import_module uint64.\n\n%-----------------------------------------------------------------------%\n\nexit_error(ErrMsg, !IO) :-\n write_string(stderr_stream, ErrMsg ++ \"\\n\", !IO),\n set_exit_status(1, !IO).\n\n%-----------------------------------------------------------------------%\n\ncurry(F, A - B) = F(A, B).\n\n%-----------------------------------------------------------------------%\n\none_item(Xs) =\n ( if Xs = [X] then\n X\n else\n unexpected($file, $pred, \"Expected a list with only one item\")\n ).\n\nfirst_item([]) =\n unexpected($file, $pred, \"Expected a list with at least one item\").\nfirst_item([X | _]) =\n X.\n\none_item_in_set(Set) = X :-\n ( if is_singleton(Set, X0) then\n X = X0\n else\n unexpected($file, $pred, \"Expected a set with only one item\")\n ).\n\n%-----------------------------------------------------------------------%\n\nmaybe_list(yes(X)) = [X].\nmaybe_list(no) = [].\n\nlist_maybe_to_list([]) = [].\nlist_maybe_to_list([no | List]) = list_maybe_to_list(List).\nlist_maybe_to_list([yes(X) | List]) = [X | list_maybe_to_list(List)].\n\n%-----------------------------------------------------------------------%\n\nmaybe_cord(yes(X)) = singleton(X).\nmaybe_cord(no) = init.\n\n%-----------------------------------------------------------------------%\n\nfind_duplicates(List, Dups) :-\n find_duplicates_2(List, set.init, set.init, Dups).\n\n:- pred find_duplicates_2(list(X)::in, set(X)::in, set(X)::in, set(X)::out) is det.\n\nfind_duplicates_2([], _, !Dups).\nfind_duplicates_2([X | Xs], !.Seen, !Dups) :-\n ( if member(X, !.Seen) then\n insert(X, !Dups)\n else\n insert(X, !Seen)\n ),\n find_duplicates_2(Xs, !.Seen, !Dups).\n\n%-----------------------------------------------------------------------%\n\nmaybe_error_map(_, error(Error)) = error(Error).\nmaybe_error_map(Func, ok(X)) = ok(Func(X)).\n\n%-----------------------------------------------------------------------%\n\nmaybe_error_list(Results) =\n maybe_error_list_ok(Results, []).\n\n:- func maybe_error_list_ok(list(maybe_error(A, E)), list(A)) =\n maybe_error(list(A), list(E)).\n\nmaybe_error_list_ok([], Rev) = ok(reverse(Rev)).\nmaybe_error_list_ok([ok(R) | Rs], Rev) =\n maybe_error_list_ok(Rs, [R | Rev]).\nmaybe_error_list_ok([error(E) | Rs], _) =\n maybe_error_list_error(Rs, [E]).\n\n:- func maybe_error_list_error(list(maybe_error(A, E)), list(E)) =\n maybe_error(list(A), list(E)).\n\nmaybe_error_list_error([], Rev) = error(reverse(Rev)).\nmaybe_error_list_error([error(E) | Rs], Rev) =\n maybe_error_list_error(Rs, [E | Rev]).\nmaybe_error_list_error([ok(_) | Rs], Rev) =\n maybe_error_list_error(Rs, Rev).\n\n%-----------------------------------------------------------------------%\n\nset_map_foldl2(Pred, Set0, Set, !Acc1, !Acc2) :-\n List0 = to_sorted_list(Set0),\n list.map_foldl2(Pred, List0, List, !Acc1, !Acc2),\n Set = list_to_set(List).\n\n%-----------------------------------------------------------------------%\n\nmap2_corresponding(P, Xs0, Ys0, As, Bs) :-\n ( if\n Xs0 = [],\n Ys0 = []\n then\n As = [],\n Bs = []\n else if\n Xs0 = [X | Xs],\n Ys0 = [Y | Ys]\n then\n P(X, Y, A, B),\n map2_corresponding(P, Xs, Ys, As0, Bs0),\n As = [A | As0],\n Bs = [B | Bs0]\n else\n unexpected($file, $pred, \"Mismatched inputs\")\n ).\n\nmap4_corresponding2(P, As0, Bs0, Cs0, Ds0, Xs, Ys) :-\n ( if\n As0 = [],\n Bs0 = [],\n Cs0 = [],\n Ds0 = []\n then\n Xs = [],\n Ys = []\n else if\n As0 = [A | As],\n Bs0 = [B | Bs],\n Cs0 = [C | Cs],\n Ds0 = [D | Ds]\n then\n P(A, B, C, D, X, Y),\n map4_corresponding2(P, As, Bs, Cs, Ds, Xs0, Ys0),\n Xs = [X | Xs0],\n Ys = [Y | Ys0]\n else\n unexpected($file, $pred, \"Mismatched inputs\")\n ).\n\n%-----------------------------------------------------------------------%\n\nremove_first_match_map(Pred, Y, [X | Xs], Ys) :-\n ( if Pred(X, YP) then\n Y = YP,\n Ys = Xs\n else\n remove_first_match_map(Pred, Y, Xs, Ys0),\n Ys = [X | Ys0]\n ).\n\n%-----------------------------------------------------------------------%\n\ndet_uint32_to_int(Uint32) = Int :-\n Int = cast_to_int(Uint32),\n % This should catch cases when this doesn't work.\n ( if from_int(Int, Uint32) then\n true\n else\n unexpected($file, $pred, \"Uint32 out of range\")\n ).\n\n%-----------------------------------------------------------------------%\n\ndet_uint64_to_int(Uint64) = Int :-\n Int = cast_to_int(Uint64),\n ( if from_int(Int, Uint64) then\n true\n else\n unexpected($file, $pred, \"Uint64 out of range\")\n ).\n\n%-----------------------------------------------------------------------%\n\nlist_join(_, []) = [].\nlist_join(_, [X]) = [X].\nlist_join(J, [X1, X2 | Xs]) =\n [X1 | J ++ list_join(J, [X2 | Xs])].\n\n%-----------------------------------------------------------------------%\n\nbag_list_to_bag(LoB) =\n foldl(union, LoB, init).\n\n%-----------------------------------------------------------------------%\n\nstring_join(Sep, List) = append_list(list_join([Sep], List)).\n\n%-----------------------------------------------------------------------%\n\nlist_delete_first_match(Xs0, Pred, Xs) :-\n list_delete_first_match(Xs0, Pred, [], Xs).\n\n:- pred list_delete_first_match(list(T), pred(T), list(T), list(T)).\n:- mode list_delete_first_match(in, pred(in) is semidet, in, out) is semidet.\n\nlist_delete_first_match([X | Xs0], Pred, !Xs) :-\n ( if Pred(X) then\n reverse(!Xs)\n else\n !:Xs = [X | !.Xs],\n list_delete_first_match(Xs0, Pred, !Xs)\n ).\n\n%-----------------------------------------------------------------------%\n\npower_intersect_list([]) = unexpected($file, $pred, \"Answer is infinite\").\npower_intersect_list([H | T]) =\n power_intersect_list_2(H, T).\n\n:- func power_intersect_list_2(set(T), list(set(T))) = set(T).\n\npower_intersect_list_2(A, []) = A.\npower_intersect_list_2(A, [B | Ls]) =\n power_intersect_list_2(A `intersect` B, Ls).\n\n%-----------------------------------------------------------------------%\n\nhandle_bool_option(OptionTable, Option, True, False) = Result :-\n lookup_bool_option(OptionTable, Option, Bool),\n ( Bool = yes,\n Result = True\n ; Bool = no,\n Result = False\n ).\n\n%-----------------------------------------------------------------------%\n\nmap_set_or_update(UpdateFn, Key, Value, !Map) :-\n ( if search(!.Map, Key, OldValue) then\n det_update(Key, UpdateFn(OldValue), !Map)\n else\n set(Key, Value, !Map)\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.my_exception.m", "content": "%-----------------------------------------------------------------------%\n% Exception utility code\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module util.my_exception.\n\n:- interface.\n\n:- import_module io.\n:- import_module maybe.\n:- import_module context.\n\n%-----------------------------------------------------------------------%\n\n % This exception and its routines are temporary, they should be used for\n % code that finds a compilation error, but error handling is not\n % properly setup in that area of the compiler. This helps by making\n % these errors a little more friendly, and by allowing us to search the\n % source code for these locations when we eventually add error handling.\n %\n:- type compile_error_exception\n ---> compile_error_exception(string, string, maybe(context), string).\n\n:- pred compile_error(string::in, string::in, string::in) is erroneous.\n\n:- pred compile_error(string::in, string::in, context::in, string::in)\n is erroneous.\n\n % This is an alternative to the sorry/1 predicate in the Mercury\n % standard library. This predicate uses a dedicated exception type and\n % is caught explicitly by plasmac's main/2 predicate.\n %\n:- type unimplemented_exception\n ---> unimplemented_exception(string, string, maybe(context), string).\n\n:- pred sorry(string::in, string::in, string::in) is erroneous.\n:- pred sorry(string::in, string::in, context::in, string::in) is erroneous.\n\n:- func sorry(string, string, string) = T.\n:- mode sorry(in, in, in) = (out) is erroneous.\n:- func sorry(string, string, context, string) = T.\n:- mode sorry(in, in, in, in) = (out) is erroneous.\n\n % Like sorry except that these exceptions are used for things we think\n % are unlikely. Like trying to roll more than 256 items on the PZ\n % stack. If they happen to real people then we'll try to address them\n % and can probably do something about them.\n %\n:- type design_limitation_exception\n ---> design_limitation_exception(string, string, string).\n\n:- pred limitation(string::in, string::in, string::in) is erroneous.\n\n% TODO: add \"unexpected\" exception.\n\n:- type tool\n ---> plzc\n ; plzasm\n ; plzgeninit\n ; plzlnk.\n\n:- type had_errors\n ---> had_errors\n ; did_not_have_errors.\n\n:- pred run_and_catch(pred(io, io), tool, had_errors, io, io).\n:- mode run_and_catch(pred(di, uo) is det, in, out, di, uo) is cc_multi.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module exception.\n:- import_module list.\n:- import_module pair.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\ncompile_error(File, Pred, Message) :-\n throw(compile_error_exception(File, Pred, no, Message)).\n\ncompile_error(File, Pred, Context, Message) :-\n throw(compile_error_exception(File, Pred, yes(Context), Message)).\n\nsorry(File, Pred, Message) :-\n throw(unimplemented_exception(File, Pred, no, Message)).\nsorry(File, Pred, Context, Message) :-\n throw(unimplemented_exception(File, Pred, yes(Context), Message)).\nsorry(File, Pred, Message) = _ :-\n my_exception.sorry(File, Pred, Message).\nsorry(File, Pred, Context, Message) = _ :-\n my_exception.sorry(File, Pred, Context, Message).\n\nlimitation(File, Pred, Message) :-\n throw(design_limitation_exception(File, Pred, Message)).\n\n%-----------------------------------------------------------------------%\n\nrun_and_catch(Run, Tool, HadErrors, !IO) :-\n ( try [io(!IO)] (\n Run(!IO)\n ) then\n HadErrors = did_not_have_errors\n catch compile_error_exception(File, Pred, MaybeContext, Msg) ->\n HadErrors = had_errors,\n Description =\n\"A compilation error occured and this error is not handled gracefully\\n\" ++\n\"by the \" ++ tool_name(Tool) ++ \". Sorry.\",\n ShortName = tool_short_name(Tool),\n print_exception(Description,\n [\"Message\" - Msg] ++\n context_line(MaybeContext) ++\n [(ShortName ++ \" location\") - Pred,\n (ShortName ++ \" file\") - File],\n !IO)\n catch unimplemented_exception(File, Pred, MaybeContext, Feature) ->\n HadErrors = had_errors,\n print_exception(\n\"A feature required by your program is currently unimplemented,\\n\" ++\n\"however this is something we hope to implement in the future. Sorry\\n\",\n [\"Feature\" - Feature] ++\n context_line(MaybeContext) ++\n [\"Location\" - Pred,\n \"File\" - File],\n !IO)\n catch design_limitation_exception(File, Pred, Message) ->\n HadErrors = had_errors,\n print_exception(\n\"This program pushes Plasma beyond what it is designed to do. If this\\n\" ++\n\"happens on real programs (not a stress test) please contact us and\\n\" ++\n\"we'll do what we can to fix it.\",\n [\"Message\" - Message,\n \"Location\" - Pred,\n \"File\" - File],\n !IO)\n catch software_error(Message) ->\n HadErrors = had_errors,\n print_exception(\n\"The \" ++ tool_name(Tool) ++\n \" has crashed due to a bug (an assertion failure or\\n\" ++\n\"unhandled state). Please make a bug report. Sorry.\",\n [\"Message\" - Message], !IO)\n ).\n\n:- func context_line(maybe(context)) = list(pair(string, string)).\n\ncontext_line(no) = [].\ncontext_line(yes(Context)) = [\"Context\" - context_string(Context)].\n\n:- pred print_exception(string::in, list(pair(string, string))::in,\n io::di, io::uo) is det.\n\nprint_exception(Message, Fields, !IO) :-\n write_string(stderr_stream, Message, !IO),\n io.nl(!IO),\n foldl(exit_exception_field, Fields, !IO).\n\n:- pred exit_exception_field(pair(string, string)::in, io::di, io::uo)\n is det.\n\nexit_exception_field(Name - Value, !IO) :-\n write_string(pad_right(Name ++ \": \", ' ', 20), !IO),\n write_string(Value, !IO),\n nl(!IO).\n\n:- func tool_name(tool) = string.\n\ntool_name(plzc) = \"Plasma compiler\".\ntool_name(plzasm) = \"Plasma bytecode assembler\".\ntool_name(plzlnk) = \"Plasma bytecode linker\".\ntool_name(plzgeninit) = \"Plasma foreign interface generator\".\n\n:- func tool_short_name(tool) = string.\n\ntool_short_name(T) = string(T).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.my_io.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module util.my_io.\n%\n% Tag Length Value serialisation.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module list.\n:- import_module maybe.\n\n%-----------------------------------------------------------------------%\n\n % write_len_string(Stream, String, !IO)\n %\n % Write a 16bit length followed by the string.\n %\n:- pred write_len_string(binary_output_stream::in, string::in,\n io::di, io::uo) is det.\n\n:- pred read_len_string(binary_input_stream::in, maybe_error(string)::out,\n io::di, io::uo) is det.\n\n % write_string(Stream, String, !IO)\n %\n:- pred write_string(binary_output_stream::in, string::in,\n io::di, io::uo) is det.\n\n:- pred read_string(binary_input_stream::in, int::in,\n maybe_error(string)::out, io::di, io::uo) is det.\n\n:- pred read_uint8(binary_input_stream::in, maybe_error(uint8)::out,\n io::di, io::uo) is det.\n\n:- pred read_uint16(binary_input_stream::in, maybe_error(uint16)::out,\n io::di, io::uo) is det.\n\n:- pred read_uint32(binary_input_stream::in, maybe_error(uint32)::out,\n io::di, io::uo) is det.\n\n:- pred read_int32(binary_input_stream::in, maybe_error(int32)::out,\n io::di, io::uo) is det.\n\n:- pred read_uint64(binary_input_stream::in, maybe_error(uint64)::out,\n io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n\n:- func combine_read_2(maybe_error(T1), maybe_error(T2))\n = maybe_error({T1, T2}).\n\n:- func combine_read_3(maybe_error(T1), maybe_error(T2), maybe_error(T3))\n = maybe_error({T1, T2, T3}).\n\n:- func combine_read_5(maybe_error(T1), maybe_error(T2), maybe_error(T3),\n maybe_error(T4), maybe_error(T5))\n = maybe_error({T1, T2, T3, T4, T5}).\n\n:- func combine_read_6(maybe_error(T1), maybe_error(T2), maybe_error(T3),\n maybe_error(T4), maybe_error(T5), maybe_error(T6))\n = maybe_error({T1, T2, T3, T4, T5, T6}).\n\n:- func combine_read_7(maybe_error(T1), maybe_error(T2), maybe_error(T3),\n maybe_error(T4), maybe_error(T5), maybe_error(T6), maybe_error(T7))\n = maybe_error({T1, T2, T3, T4, T5, T6, T7}).\n\n%-----------------------------------------------------------------------%\n\n:- type temp_file_info\n ---> temp_file_info(\n tfi_temp_file :: string,\n tfi_final_file :: string\n ).\n\n % Write a temporary file that represents the final file.\n %\n % The result, if successful, contains the temporary and final filename.\n % It can later be used by move_temps_if_successful to move the temporary\n % file over the final file.\n %\n % write_temp(Write, Open, Close, FinalFilename, Result, !IO),\n %\n:- pred write_temp(\n pred(string, io.res(S), io, io),\n pred(S, io, io),\n pred(S, maybe_error, io, io),\n string, maybe_error(temp_file_info), io, io).\n:- mode write_temp(\n pred(in, out, di, uo) is det,\n pred(in, di, uo) is det,\n pred(in, out, di, uo) is det,\n in, out, di, uo) is det.\n\n % Given a list of results from multiple calls to write_temp. If they all\n % succeed then move all the files into their correct position. If any\n % of them fail then return the failure.\n %\n:- pred move_temps_if_successful(list(maybe_error(temp_file_info))::in,\n maybe_error::out, io::di, io::uo) is det.\n\n % write_temp_and_move(OpenPred, ClosePred, WritePred, Filename, Result,\n % !IO)\n %\n:- pred write_temp_and_move(\n pred(string, io.res(S), io, io),\n pred(S, io, io),\n pred(S, maybe_error, io, io),\n string, maybe_error, io, io).\n:- mode write_temp_and_move(\n pred(in, out, di, uo) is det,\n pred(in, di, uo) is det,\n pred(in, out, di, uo) is det,\n in, out, di, uo) is det.\n\n%-----------------------------------------------------------------------%\n\n % List of all the files in the named directory.\n %\n % get_dir_list(Dir, Result, !IO)\n %\n:- pred get_dir_list(string::in, maybe_error(list(string))::out,\n io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module bool.\n:- import_module char.\n:- import_module int.\n:- import_module string.\n:- import_module uint16.\n:- import_module uint8.\n\n:- import_module util.path.\n\n%-----------------------------------------------------------------------%\n\nwrite_len_string(Stream, String, !IO) :-\n write_binary_uint16_le(Stream, det_from_int(length(String)), !IO),\n write_string(Stream, String, !IO).\n\nread_len_string(Stream, MaybeString, !IO) :-\n read_uint16(Stream, MaybeLen, !IO),\n ( MaybeLen = ok(Len),\n read_string(Stream, to_int(Len), MaybeString, !IO)\n ; MaybeLen = error(Error),\n MaybeString = error(Error)\n ).\n\nwrite_string(Stream, String, !IO) :-\n foldl(write_char_as_byte(Stream), String, !IO).\n\nread_string(Stream, Len, MaybeString, !IO) :-\n read_string_2(Stream, Len, \"\", MaybeString, !IO).\n\n:- pred read_string_2(binary_input_stream::in, int::in, string::in,\n maybe_error(string)::out, io::di, io::uo) is det.\n\nread_string_2(Stream, Len, Head, MaybeString, !IO) :-\n ( if Len > 0 then\n read_char_as_byte(Stream, MaybeChar, !IO),\n ( MaybeChar = ok(Char),\n % This is pretty inefficient. Fix it later / after bootstrap.\n % It's an interesting case where we should make the efficient\n % thing natural/easy/convenient in Plasma.\n read_string_2(Stream, Len - 1, Head ++ char_to_string(Char),\n MaybeString, !IO)\n ; MaybeChar = error(Error),\n MaybeString = error(Error)\n )\n else\n MaybeString = ok(Head)\n ).\n\n:- pred write_char_as_byte(binary_output_stream::in, char::in,\n io::di, io::uo) is det.\n\nwrite_char_as_byte(Stream, Char, !IO) :-\n write_binary_uint8(Stream, det_from_int(to_int(Char) /\\ 0xFF), !IO).\n\n:- pred read_char_as_byte(binary_input_stream::in, maybe_error(char)::out,\n io::di, io::uo) is det.\n\nread_char_as_byte(Stream, MaybeChar, !IO) :-\n read_binary_uint8(Stream, Result, !IO),\n ( Result = ok(UInt8),\n MaybeChar = ok(det_from_int(to_int(UInt8)))\n ; Result = eof,\n MaybeChar = error(\"eof\")\n ; Result = error(Error),\n MaybeChar = error(error_message(Error))\n ).\n\n%-----------------------------------------------------------------------%\n\nread_uint8(Stream, Result, !IO) :-\n read_binary_uint8(Stream, Result0, !IO),\n ( Result0 = ok(UInt8),\n Result = ok(UInt8)\n ; Result0 = eof,\n Result = error(\"eof\")\n ; Result0 = error(Error),\n Result = error(error_message(Error))\n ).\n\nread_uint16(Stream, simplify_result(Result), !IO) :-\n read_binary_uint16_le(Stream, Result, !IO).\n\nread_uint32(Stream, simplify_result(Result), !IO) :-\n read_binary_uint32_le(Stream, Result, !IO).\n\nread_int32(Stream, simplify_result(Result), !IO) :-\n read_binary_int32_le(Stream, Result, !IO).\n\nread_uint64(Stream, simplify_result(Result), !IO) :-\n read_binary_uint64_le(Stream, Result, !IO).\n\n:- func simplify_result(maybe_incomplete_result(T)) = maybe_error(T).\n\nsimplify_result(Result) = MaybeInt :-\n ( Result = ok(Int),\n MaybeInt = ok(Int)\n ;\n ( Result = eof\n ; Result = incomplete(_)\n ),\n MaybeInt = error(\"eof\")\n ; Result = error(Error),\n MaybeInt = error(error_message(Error))\n ).\n\n%-----------------------------------------------------------------------%\n\ncombine_read_2(Res1, Res2) = Res :-\n ( Res1 = ok(Ok1),\n ( Res2 = ok(Ok2),\n Res = ok({Ok1, Ok2})\n ; Res2 = error(Error),\n Res = error(Error)\n )\n ; Res1 = error(Error),\n Res = error(Error)\n ).\n\ncombine_read_3(Res1, Res2, Res3) = Res :-\n ( Res1 = ok(Ok1),\n ( Res2 = ok(Ok2),\n ( Res3 = ok(Ok3),\n Res = ok({Ok1, Ok2, Ok3})\n ; Res3 = error(Error),\n Res = error(Error)\n )\n ; Res2 = error(Error),\n Res = error(Error)\n )\n ; Res1 = error(Error),\n Res = error(Error)\n ).\n\ncombine_read_5(Res1, Res2, Res3, Res4, Res5) = Res :-\n ( Res1 = ok(Ok1),\n ( Res2 = ok(Ok2),\n ( Res3 = ok(Ok3),\n ( Res4 = ok(Ok4),\n ( Res5 = ok(Ok5),\n Res = ok({Ok1, Ok2, Ok3, Ok4, Ok5})\n ; Res5 = error(Error),\n Res = error(Error)\n )\n ; Res4 = error(Error),\n Res = error(Error)\n )\n ; Res3 = error(Error),\n Res = error(Error)\n )\n ; Res2 = error(Error),\n Res = error(Error)\n )\n ; Res1 = error(Error),\n Res = error(Error)\n ).\n\ncombine_read_6(Res1, Res2, Res3, Res4, Res5, Res6) = Res :-\n ( Res1 = ok(Ok1),\n ( Res2 = ok(Ok2),\n ( Res3 = ok(Ok3),\n ( Res4 = ok(Ok4),\n ( Res5 = ok(Ok5),\n ( Res6 = ok(Ok6),\n Res = ok({Ok1, Ok2, Ok3, Ok4, Ok5, Ok6})\n ; Res6 = error(Error),\n Res = error(Error)\n )\n ; Res5 = error(Error),\n Res = error(Error)\n )\n ; Res4 = error(Error),\n Res = error(Error)\n )\n ; Res3 = error(Error),\n Res = error(Error)\n )\n ; Res2 = error(Error),\n Res = error(Error)\n )\n ; Res1 = error(Error),\n Res = error(Error)\n ).\n\ncombine_read_7(Res1, Res2, Res3, Res4, Res5, Res6, Res7) = Res :-\n ( Res1 = ok(Ok1),\n ( Res2 = ok(Ok2),\n ( Res3 = ok(Ok3),\n ( Res4 = ok(Ok4),\n ( Res5 = ok(Ok5),\n ( Res6 = ok(Ok6),\n ( Res7 = ok(Ok7),\n Res = ok({Ok1, Ok2, Ok3, Ok4, Ok5, Ok6, Ok7})\n ; Res7 = error(Error),\n Res = error(Error)\n )\n ; Res6 = error(Error),\n Res = error(Error)\n )\n ; Res5 = error(Error),\n Res = error(Error)\n )\n ; Res4 = error(Error),\n Res = error(Error)\n )\n ; Res3 = error(Error),\n Res = error(Error)\n )\n ; Res2 = error(Error),\n Res = error(Error)\n )\n ; Res1 = error(Error),\n Res = error(Error)\n ).\n\n%-----------------------------------------------------------------------%\n\nwrite_temp(Open, Close, Write, Filename, Result, !IO) :-\n TempFilename = make_temp_filename(Filename),\n Open(TempFilename, MaybeFile, !IO),\n ( MaybeFile = ok(File),\n Write(File, Result1, !IO),\n Close(File, !IO),\n ( Result1 = ok,\n Result = ok(temp_file_info(TempFilename, Filename))\n ; Result1 = error(Error),\n Result = error(Error)\n )\n ; MaybeFile = error(Error),\n Result =\n error(format(\"%s: %s\", [s(Filename), s(error_message(Error))]))\n ).\n\nmove_temps_if_successful([], ok, !IO).\nmove_temps_if_successful([R | Rs], Result, !IO) :-\n ( R = ok(TempFileInfo),\n move_temps_if_successful(Rs, Result0, !IO),\n ( Result0 = ok,\n TempFilename = TempFileInfo ^ tfi_temp_file,\n Filename = TempFileInfo ^ tfi_final_file,\n io.rename_file(TempFilename, Filename, MoveRes, !IO),\n ( MoveRes = ok,\n Result = ok\n ; MoveRes = error(Error),\n Result =\n error(format(\"%s: %s\", \n [s(Filename), s(error_message(Error))]))\n )\n ; Result0 = error(_),\n Result = Result0\n )\n ; R = error(Error),\n Result = error(Error)\n ).\n\nwrite_temp_and_move(Open, Close, Write, Filename, Result, !IO) :-\n write_temp(Open, Close, Write, Filename, Result0, !IO),\n ( Result0 = ok(TempFileInfo),\n io.rename_file(TempFileInfo ^ tfi_temp_file, Filename, MoveRes, !IO),\n ( MoveRes = ok,\n Result = ok\n ; MoveRes = error(Error),\n Result =\n error(format(\"%s: %s\", [s(Filename), s(error_message(Error))]))\n )\n ; Result0 = error(Error),\n Result = error(Error)\n ).\n\n%-----------------------------------------------------------------------%\n\nget_dir_list(Dirname, MaybeFiles, !IO) :-\n opendir(Dirname, MaybeDir, !IO),\n ( MaybeDir = ok(Dir),\n lsdir(Dir, [], MaybeFiles, !IO),\n closedir(Dir, !IO)\n ; MaybeDir = error(Error),\n MaybeFiles = error(Error)\n ).\n\n:- pragma foreign_decl(\"C\", local,\n \"\n #include \n #include \n \").\n\n:- type dir.\n:- pragma foreign_type(\"C\", dir, \"DIR*\").\n\n:- pred opendir(string::in, maybe_error(dir)::out, io::di, io::uo) is det.\n\nopendir(Name, MaybeDir, !IO) :-\n opendir_c(Name, Ok, Dir, Error, !IO),\n ( Ok = yes,\n MaybeDir = ok(Dir)\n ; Ok = no,\n MaybeDir = error(Error)\n ).\n\n:- pred opendir_c(string::in, bool::out, dir::out, string::out,\n io::di, io::uo) is det.\n\n:- pragma foreign_proc(\"C\",\n opendir_c(Name::in, Ok::out, Dir::out, Error::out, _IO0::di, _IO::uo),\n [promise_pure, will_not_call_mercury, will_not_throw_exception,\n thread_safe],\n \"\n Dir = opendir(Name);\n if (Dir) {\n Ok = MR_TRUE;\n Error = NULL;\n } else {\n Ok = MR_FALSE;\n Error = GC_strdup(strerror(errno));\n }\n \").\n\n\n:- pred closedir(dir::in, io::di, io::uo) is det.\n\n:- pragma foreign_proc(\"C\",\n closedir(Dir::in, _IO0::di, _IO::uo),\n [promise_pure, will_not_call_mercury, will_not_throw_exception,\n thread_safe],\n \"\n closedir(Dir);\n \").\n\n:- pred lsdir(dir::in, list(string)::in, maybe_error(list(string))::out,\n io::di, io::uo) is det.\n\nlsdir(Dir, Acc, Result, !IO) :-\n readdir(Dir, MaybeRead, !IO),\n ( MaybeRead = ok(Name),\n lsdir(Dir, [Name | Acc], Result, !IO)\n ; MaybeRead = eof,\n Result = ok(reverse(Acc))\n ; MaybeRead = error(Error),\n Result = error(Error)\n ).\n\n:- type readdir_result\n ---> ok(string)\n ; eof\n ; error(string).\n\n:- pred readdir(dir::in, readdir_result::out, io::di, io::uo) is det.\n\nreaddir(Dir, Result, !IO) :-\n readdir_c(Dir, Ok, EOF, Entry, Error, !IO),\n ( Ok = yes,\n Result = ok(Entry)\n ; Ok = no,\n ( EOF = yes,\n Result = eof\n ; EOF = no,\n Result = error(Error)\n )\n ).\n\n:- pred readdir_c(dir::in, bool::out, bool::out, string::out, string::out,\n io::di, io::uo) is det.\n\n:- pragma foreign_proc(\"C\",\n readdir_c(Dir::in, Ok::out, Eof::out, Entry::out, Error::out,\n _IO0::di, _IO::uo),\n [promise_pure, will_not_call_mercury, will_not_throw_exception],\n \"\n errno = 0;\n\n // readdir is not defined to be threadsafe, but most modern systems\n // will implement it this way. We don not need to take any chances.\n struct dirent *ent = readdir(Dir);\n if (ent) {\n Ok = MR_TRUE;\n Entry = GC_strdup(ent->d_name);\n } else {\n Ok = MR_FALSE;\n if (errno) {\n Eof = MR_FALSE;\n Error = GC_strdup(strerror(errno));\n } else {\n Eof = MR_TRUE;\n }\n }\n \").\n\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.my_string.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module util.my_string.\n%\n% String manipulation utils.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Routines for escaping and unescaping strings.\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n%-----------------------------------------------------------------------%\n\n:- func escape_string(string) = string.\n\n:- func unescape_string(string) = string.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module char.\n:- import_module int.\n:- import_module list.\n:- import_module string.\n\n:- import_module util.my_exception.\n\n%-----------------------------------------------------------------------%\n\nescape_string(String) = from_char_list(['\"'] ++\n escape_chars(to_char_list(String), []) ++ ['\"']).\n\n:- func escape_chars(list(char), list(char)) = list(char).\n\nescape_chars([], Done) = reverse(Done).\nescape_chars([C0 | Cs], Done0) = Done :-\n ( if escape_char(C, C0) then\n Done1 = [C, '\\\\' | Done0]\n else if C0 = ('\\\"') then\n Done1 = ['\"', '\\\\' | Done0]\n else\n Done1 = [C0 | Done0]\n ),\n Done = escape_chars(Cs, Done1).\n\nunescape_string(S0) = from_char_list(C) :-\n between(S0, 1, length(S0) - 1, S1),\n C1 = to_char_list(S1),\n unescape_string_loop(C1) = C.\n\n:- func unescape_string_loop(list(char)) = list(char).\n\nunescape_string_loop([]) = [].\nunescape_string_loop([C | Cs0]) = Cs :-\n ( if C = ('\\\\') then\n Cs = unescape_string_loop_do_escape(Cs0)\n else\n Cs = [C | unescape_string_loop(Cs0)]\n ).\n\n:- func unescape_string_loop_do_escape(list(char)) = list(char).\n\nunescape_string_loop_do_escape([]) =\n util.my_exception.sorry($file, $pred,\n \"Lexer does not support escaping the double quote\").\nunescape_string_loop_do_escape([C0 | Cs0]) = Cs :-\n ( if escape_char(C0, C1) then\n C = C1\n else\n % Interpret the escaped character as if it was not escaped.\n C = C0\n ),\n Cs = [C | unescape_string_loop(Cs0)].\n\n:- pred escape_char(char, char).\n:- mode escape_char(in, out) is semidet.\n:- mode escape_char(out, in) is semidet.\n\nescape_char('n', '\\n').\nescape_char('r', '\\r').\nescape_char('t', '\\t').\nescape_char('v', '\\v').\nescape_char('f', '\\f').\nescape_char('b', '\\b').\nescape_char('\\\\', '\\\\').\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.my_time.m", "content": "%-----------------------------------------------------------------------%\n% Timing utility code\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module util.my_time.\n\n:- interface.\n\n:- import_module io.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\n:- type time2(T)\n ---> time2(\n t_real_time :: T,\n t_cpu_time :: T\n ).\n\n:- type timestamp.\n\n:- type duration.\n\n%-----------------------------------------------------------------------%\n\n:- pred now(time2(timestamp)::out, io::di, io::uo) is det.\n\n:- func diff_time(time2(timestamp), time2(timestamp)) = time2(duration).\n\n:- func str_time(duration) = string.\n\n:- func format_duration(time2(duration)) = string.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module float.\n:- import_module int64.\n:- import_module list.\n\n:- type timestamp == timespec.\n\n:- type duration == timespec.\n\n%-----------------------------------------------------------------------%\n\n:- pragma foreign_decl(\"C\",\n \"#include \").\n\n:- type clock_id\n ---> clock_real\n ; clock_cpu.\n\n:- pragma foreign_enum(\"C\", clock_id/0,\n [\n clock_real - \"CLOCK_MONOTONIC\",\n % Linux specific\n clock_cpu - \"CLOCK_PROCESS_CPUTIME_ID\"\n ]).\n\n:- type timespec.\n\n:- pragma foreign_type(\"C\", timespec, \"struct timespec\").\n\n:- pred timespec(timespec, int64, int64).\n:- mode timespec(in, out, out) is det.\n:- mode timespec(out, in, in) is det.\n\n:- pragma foreign_proc(\"C\",\n timespec(TS::in, Secs::out, NSecs::out),\n [promise_pure, thread_safe, will_not_throw_exception,\n will_not_call_mercury],\n \"\n Secs = TS.tv_sec;\n NSecs = TS.tv_nsec;\n \").\n\n:- pragma foreign_proc(\"C\",\n timespec(TS::out, Secs::in, NSecs::in),\n [promise_pure, thread_safe, will_not_throw_exception,\n will_not_call_mercury],\n \"\n TS.tv_sec = Secs;\n TS.tv_nsec = NSecs;\n \").\n\n%-----------------------------------------------------------------------%\n\nnow(time2(Real, CPU), !IO) :-\n now(clock_real, Real, !IO),\n now(clock_cpu, CPU, !IO).\n\n:- pred now(clock_id::in, timestamp::out, io::di, io::uo) is det.\n\n:- pragma foreign_proc(\"C\",\n now(Clock::in, Time::out, _IO0::di, _IO::uo),\n [promise_pure, thread_safe, will_not_throw_exception,\n will_not_call_mercury],\n \"\n int ret = clock_gettime(Clock, &Time);\n if (ret != 0) {\n perror(\"\"Warning, clock_gettime\"\");\n Time.tv_sec = 0;\n Time.tv_nsec = 0;\n }\n \").\n\n%-----------------------------------------------------------------------%\n\ndiff_time(time2(RealAfter, CPUAfter), time2(RealBefore, CPUBefore)) =\n time2(RealAfter - RealBefore, CPUAfter - CPUBefore).\n\n:- func timespec - timespec = timespec.\n\nT1 - T2 = T :-\n timespec(T1, T1Sec0, T1NSec0),\n timespec(T2, T2Sec, T2NSec),\n\n ( if T1NSec0 < T2NSec then\n % Need to carry.\n T1Sec = T1Sec0 - 1i64,\n T1NSec = T1NSec0 + 1_000_000_000i64\n else\n T1Sec = T1Sec0,\n T1NSec = T1NSec0\n ),\n timespec(T, T1Sec - T2Sec, T1NSec - T2NSec).\n\n%-----------------------------------------------------------------------%\n\nstr_time(Duration) = format(\"%.2f%s\", [f(Float), s(Unit)]) :-\n timespec(Duration, Secs, NSecs),\n ( if Secs > 0i64 then\n Float = float.cast_from_int64(Secs) +\n (float.cast_from_int64(NSecs) / 1_000_000_000.0),\n Unit = \"s\"\n else if NSecs > 1_000_000i64 then\n Float = float.cast_from_int64(NSecs) / 1_000_000.0,\n Unit = \"ms\"\n else if NSecs > 1_000i64 then\n Float = float.cast_from_int64(NSecs) / 1_000.0,\n Unit = \"us\"\n else\n Float = float.cast_from_int64(NSecs),\n Unit = \"ns\"\n ).\n\nformat_duration(Time) =\n format(\"real: %s, cpu: %s\",\n [s(str_time(Time ^ t_real_time)),\n s(str_time(Time ^ t_cpu_time))]).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.path.m", "content": "%-----------------------------------------------------------------------%\n% Path Utility code\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- module util.path.\n\n:- interface.\n\n%-----------------------------------------------------------------------%\n\n % file_and_dir(Path, Dir, File).\n %\n % Path = Dir ++ \"/\" ++ File AND File has no '/'.\n %\n:- pred file_and_dir(string, string, string).\n:- mode file_and_dir(in, out, out) is semidet.\n:- mode file_and_dir(out, in, in) is det.\n\n % file_and_dir(DefaultDir, Path, Dir, File).\n %\n % As above except if Path is unqualified then Dir = DefaultDir.\n %\n:- pred file_and_dir_det(string, string, string, string).\n:- mode file_and_dir_det(in, in, out, out) is det.\n\n % file_part(Path, File) :-\n % file_and_dir(Path, _, File).\n %\n:- pred file_part(string::in, string::out) is det.\n\n % file_change_extension(ExtA, ExtB, FileA, FileB)\n % Basename ++ ExtA = FileA,\n % Basename ++ ExtB = FileB\n %\n:- pred file_change_extension(string, string, string, string).\n:- mode file_change_extension(in, in, in, out) is semidet.\n\n % If the original source file doesn't have the right extension, then\n % simply append the new extension on the end.\n %\n:- pred file_change_extension_det(string, string, string, string).\n:- mode file_change_extension_det(in, in, in, out) is det.\n\n % filename_extension(Ext, FullName, Base).\n %\n % FullName = Base ++ Ext\n %\n:- pred filename_extension(string, string, string).\n:- mode filename_extension(in, in, out) is semidet.\n\n:- pred is_absolute(string::in) is semidet.\n:- pred is_relative(string::in) is semidet.\n\n%-----------------------------------------------------------------------%\n\n % TempFilename = make_temp_filename(Filename),\n %\n % Make a file name similar to Filename that can be used to write\n % incomplete data before moving it to Filename.\n %\n:- func make_temp_filename(string) = string.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module char.\n:- import_module int.\n:- import_module list.\n:- import_module pair.\n:- import_module require.\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\n:- pragma promise_equivalent_clauses(file_and_dir/3).\n\nfile_and_dir(Path::in, Dir::out, File::out) :-\n FilePartLength = suffix_length((pred(C::in) is semidet :-\n C \\= ('/')\n ), Path),\n % This length is in code units.\n left(Path, length(Path) - FilePartLength - 1, Dir),\n Dir \\= \"\",\n right(Path, FilePartLength, File).\nfile_and_dir(Path::out, Dir::in, File::in) :-\n Path = Dir ++ \"/\" ++ File.\n\nfile_and_dir_det(DefaultDir, Path, Dir, File) :-\n ( if file_and_dir(Path, Dir0, File0) then\n Dir = Dir0,\n File = File0\n else\n Dir = DefaultDir,\n File = Path\n ).\n\nfile_part(Path, File) :-\n file_and_dir_det(\"\", Path, _, File).\n\nfile_change_extension(ExtA, ExtB, FileA, FileB) :-\n filename_extension(ExtA, FileA, Base),\n FileB = Base ++ ExtB.\n\nfile_change_extension_det(ExtA, ExtB, FileA, FileB) :-\n ( if file_change_extension(ExtA, ExtB, FileA, FileB0) then\n FileB = FileB0\n else\n FileB = FileA ++ ExtB\n ).\n\nfilename_extension(Ext, File, Base) :-\n remove_suffix(File, Ext, Base).\n\nis_absolute(Path) :-\n append(\"/\", _, Path).\nis_relative(Path) :-\n \\+ is_absolute(Path).\n\n%-----------------------------------------------------------------------%\n\nmake_temp_filename(Orig) =\n ( if Orig = \"\" then\n unexpected($file, $pred, \"Empty filename\")\n else\n Orig ++ \"~\"\n ).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.pretty.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module util.pretty.\n%\n% Pretty printer utils.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module cord.\n:- import_module list.\n\n%-----------------------------------------------------------------------%\n\n:- type pretty\n ---> p_unit(cord(string))\n ; p_group(pretty_group_type, list(pretty))\n ; p_group_curly(\n pgc_first_line :: list(pretty),\n pgc_open :: cord(string),\n pgc_inside :: list(pretty),\n pgc_close :: cord(string)\n )\n ; p_comment(\n pc_comment_begin :: cord(string),\n pc_inside :: list(pretty)\n )\n ; p_spc\n ; p_empty\n ; p_nl_hard\n ; p_nl_soft\n ; p_nl_double % A hard break that adds an extra newline.\n ; p_tabstop.\n\n:- type pretty_group_type\n ---> g_expr\n ; g_list\n ; g_para.\n\n:- func p_str(string) = pretty.\n% p_words will add soft breaks at every space character.\n:- func p_words(string) = list(pretty).\n:- func p_cord(cord(string)) = pretty.\n:- func p_quote(string, pretty) = pretty.\n:- func p_spc_nl = list(pretty).\n\n % The first type of pretty group is for expressions. It's what's been used\n % so far to format an expression like:\n %\n % let x = a +\n % b\n % y = foo()\n % z\n %\n:- func p_expr(list(pretty)) = pretty.\n\n % The second type is for lists, subsequent items arn't indented by a default\n % amount, they always start at the beginning, it can look like\n %\n % let x = [1,\n % 2,\n % 3]\n %\n % (the group is within the list).\n %\n:- func p_list(list(pretty)) = pretty.\n\n % The third type is for paragraphs. It is like the first type except\n % that each soft break is choosen individually rather than all-or-none.\n %\n:- func p_para(list(pretty)) = pretty.\n\n:- type options\n ---> options(\n o_max_line :: int,\n o_indent :: int\n ).\n\n:- func default_indent = int.\n\n:- func max_line = int.\n\n:- func default_options = options.\n\n % pretty(Options, CurIndent, Pretty) = Cord\n %\n:- func pretty(options, int, list(pretty)) = cord(string).\n\n % These do the same as the pretty function above, except they use\n % default options. They're useful for prettifying something with\n % defautl options to print it while throwing an exception.\n:- func pretty(list(pretty)) = cord(string).\n\n:- func pretty_str(list(pretty)) = string.\n\n%-----------------------------------------------------------------------%\n\n % pretty_callish(Prefix, Args),\n % pretty_callish(Prefix, Args, Postfix),\n %\n:- func pretty_callish(pretty, list(pretty)) = pretty.\n\n:- func pretty_optional_args(pretty, list(pretty)) = pretty.\n\n:- func pretty_seperated(list(pretty), list(pretty)) = list(pretty).\n\n % A shorthand for pretty_seperated([p_str(\", \"), p_nl_soft], X)\n %\n:- func pretty_comma_seperated(list(pretty)) = list(pretty).\n\n % maybe_pretty_args_maybe_prefix(Prefix, Items) = Pretty.\n %\n % Print a list of items with a prefix (if there are any items) and\n % parens if there are more than one item.\n %\n % [] -> \"\"\n % [X] -> Prefix ++ X\n % Xs -> pretty_callish(Prefix, Xs)\n %\n:- func maybe_pretty_args_maybe_prefix(list(pretty), list(pretty)) =\n pretty.\n\n:- func pretty_string(cord(string)) = string.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module int.\n:- import_module maybe.\n:- import_module require.\n:- import_module string.\n\n:- import_module util.mercury.\n:- import_module util.my_string.\n\n%-----------------------------------------------------------------------%\n\np_str(String) = p_unit(singleton(String)).\n\np_words(String) = list_join([p_spc, p_nl_soft], map(p_str, words(String))).\n\np_cord(Cord) = p_unit(Cord).\np_quote(Q, P) = p_group(g_list, [p_str(Q), P, p_str(Q)]).\np_spc_nl = [p_spc, p_nl_soft].\n\np_expr(Pretties) = p_group(g_expr, Pretties).\n\np_list(Pretties) = p_group(g_list, Pretties).\n\np_para(Pretties) = p_group(g_para, Pretties).\n\n%-----------------------------------------------------------------------%\n\ndefault_indent = 2.\n\nmax_line = 80.\n\ndefault_options = options(max_line, default_indent).\n\n%\n% The pretty printer is implemented in three stages:\n%\n% + The first is the \"client\" of this API that turns something like Plasma's\n% core representation the pretty printer expression defined in this\n% module's interface. One example of this is core.pretty.\n%\n% + The second is in pretty_to_pis. It turns this nested expression into a\n% flat sequence of \"print instructions\". It is not stateful and will\n% allow for some memorisation/caching.\n%\n% + The third turns this series of instructions into the final cord(string).\n% it is in pis_to_output and is stateful.\n%\n% The main state we're concerned with is the current indentation level and\n% column number, these change depending on indentation choices.\n%\n\npretty(Opts, Indent0, Pretties) = Cord :-\n ( if\n Pretties = [Pretty],\n ( Pretty = p_group(_, _)\n ; Pretty = p_group_curly(_, _, _, _)\n )\n then\n DoIndent = no_indent\n else\n DoIndent = may_indent\n ),\n Indent = indent(Indent0, duplicate_char(' ', Indent0)),\n pretty_to_cord_retry(Opts, DoIndent, Indent, g_expr, Pretties, _DidBreak,\n empty_output(Indent0), Output),\n Cord = output_to_cord(Output).\n\npretty(Pretties) = pretty(default_options, 0, Pretties).\n\npretty_str(Pretties) = append_list(list(pretty(Pretties))).\n\n:- type print_instr\n ---> pi_cord(cord(string))\n ; pi_nl\n ; pi_nl_hard\n % Start a comment without a newline\n ; pi_start_comment\n ; pi_nested(pretty_group_type, list(pretty))\n % Nested pretties with open and close (oc) print instructions\n ; pi_nested_oc(\n pinoc_first_line :: list(print_instr),\n pinoc_open :: list(print_instr),\n pinoc_body :: list(pretty),\n pinoc_close :: list(print_instr)\n )\n ; pi_custom_indent(string, list(print_instr)).\n\n%-----------------------------------------------------------------------%\n\n:- type break\n ---> no_break\n ; break.\n\n:- func pretty_to_pis(break, pretty) = list(print_instr).\n\npretty_to_pis(_, p_unit(Cord)) = [pi_cord(Cord)].\npretty_to_pis(Break, p_group(Type, Pretties)) = Out :-\n ( if\n Pretties = [p_group(TypeInner, InnerPretties)]\n then\n Out = pretty_to_pis(Break, p_group(TypeInner, InnerPretties))\n else if\n Pretties = [G @ p_group_curly(_, _, _, _)]\n then\n Out = pretty_to_pis(Break, G)\n else if\n all [P] (\n member(P, Pretties) =>\n not ( P = p_nl_hard\n ; P = p_nl_soft\n )\n )\n then\n % Don't add an indent if there's no linebreaks in this group.\n Out = condense(map(pretty_to_pis(Break), Pretties))\n else\n Out = [pi_nested(Type, Pretties)]\n ).\npretty_to_pis(Break, p_group_curly(First0, Open, Body, Close)) = Out :-\n ( if any_true(unify(p_nl_soft), Body) then\n unexpected($file, $pred, \"Soft linebreak in curly group\")\n else\n First = pretty_to_pis(Break, p_expr(First0)),\n Out = [pi_nested_oc(First, [pi_cord(Open)],\n Body, [pi_cord(Close)])]\n ).\npretty_to_pis(Break, p_comment(Begin, Body)) =\n [pi_custom_indent(\n pretty_string(Begin),\n condense(map(pretty_to_pis(Break), Body)))].\npretty_to_pis(_, p_spc) = [pi_cord(singleton(\" \"))].\npretty_to_pis(_, p_empty) = [].\npretty_to_pis(_, p_nl_hard) = [pi_nl_hard].\npretty_to_pis(_, p_nl_double) = [pi_nl_hard, pi_nl_hard].\npretty_to_pis(break, p_nl_soft) = [pi_nl].\npretty_to_pis(no_break, p_nl_soft) = [].\npretty_to_pis(_, p_tabstop) = [].\n\n:- type indent_diff\n ---> id_default\n ; id_rel(int).\n\n%-----------------------------------------------------------------------%\n\n:- type retry_or_commit\n % A choicepoint further up the calltree needs retrying so that\n % it can enable soft breaks.\n ---> fail_if_overrun\n\n % Our caller has enabled soft breaks, we may retry if we need to\n % do the same.\n ; may_break_lines.\n\n % Whether or not a newline was \"printed\".\n %\n:- type did_break\n ---> did_break\n ; did_not_break.\n\n:- type indent\n ---> indent(\n i_pos :: int,\n i_string :: string\n ).\n\n:- pred pis_to_output(options::in, retry_or_commit::in, indent::in,\n list(print_instr)::in, output_builder::in,\n maybe(output_builder)::out, did_break::out) is det.\n\npis_to_output(_, _, _, [], Output, yes(Output), did_not_break).\npis_to_output(Opts, RoC, Indent, [Pi | Pis], !.Output, MaybeOutput,\n DidBreak) :-\n ( Pi = pi_cord(New),\n ( if\n !.Output ^ pos + cord_string_len(New) > Opts ^ o_max_line,\n % We only fail here if our caller is prepared to handle it.\n RoC = fail_if_overrun\n then\n MaybeOutput = no,\n DidBreak = did_not_break\n else\n output_add_new(New, !Output),\n pis_to_output(Opts, RoC, Indent, Pis, !.Output, MaybeOutput,\n DidBreak)\n )\n ;\n ( Pi = pi_nl,\n output_newline(Indent, !Output),\n DidBreak = did_break\n % Hard breaks are only used in paragraphs, they're equivilent here.\n ; Pi = pi_nl_hard,\n output_newline(Indent, !Output),\n DidBreak = did_break\n ; Pi = pi_start_comment,\n output_start_comment(Indent, DidBreak, !Output)\n ),\n pis_to_output(Opts, RoC, Indent, Pis, !.Output, MaybeOutput, _)\n ; Pi = pi_nested(Type, Pretties),\n chain_op([\n pis_to_output_nested(Opts, RoC, Type, Indent, may_indent,\n Pretties),\n pis_to_output(Opts, RoC, Indent, Pis)\n ], !.Output, MaybeOutput, DidBreak)\n ; Pi = pi_nested_oc(First, Open, Nested, Close),\n PosOpen = !.Output ^ pos,\n chain_op([\n (pred(O::in, MO::out, DB::out) is det :-\n pis_to_output(Opts, RoC, Indent, First, O,\n MaybeFirst, FirstDidBreak),\n ( MaybeFirst = no,\n MO = no,\n DB = FirstDidBreak\n ; MaybeFirst = yes(FirstOutput),\n ( FirstDidBreak = did_break,\n MaybeNL = pi_nl\n ; FirstDidBreak = did_not_break,\n MaybeNL = pi_cord(singleton(\" \"))\n ),\n pis_to_output(Opts, RoC, Indent, [MaybeNL] ++ Open,\n FirstOutput, MO, OpenDidBreak),\n DB = did_break_combine(FirstDidBreak, OpenDidBreak)\n )\n ),\n (pred(O0::in, MO::out, DB::out) is det :-\n ( if PosOpen > Indent ^ i_pos then\n NewLevel = PosOpen + Opts ^ o_indent\n else\n NewLevel = Indent ^ i_pos + Opts ^ o_indent\n ),\n move_indent(NewLevel, Indent, SubIndent),\n\n output_newline(SubIndent, O0, O),\n pis_to_output_nested(Opts, RoC, g_expr, SubIndent, no_indent,\n Nested, O, MO, DB)\n ),\n pis_to_output(Opts, RoC, Indent, [pi_nl] ++ Close),\n pis_to_output(Opts, RoC, Indent, Pis)\n ], !.Output, MaybeOutput, DidBreak)\n ; Pi = pi_custom_indent(Begin, PisIndent),\n IndentCustom = indent(Indent ^ i_pos + length(Begin),\n Indent ^ i_string ++ Begin),\n chain_op([\n pis_to_output(Opts, RoC, IndentCustom,\n [pi_start_comment] ++ PisIndent),\n pis_to_output(Opts, RoC, Indent, Pis)\n ], !.Output, MaybeOutput, DidBreak)\n ).\n\n:- pred pis_to_output_para(options::in, indent::in,\n list(print_instr)::in, output_builder::in, output_builder::out,\n did_break::in, did_break::out) is det.\n\npis_to_output_para(_, _, [], !Output, !DidBreak) :-\n output_end_para(!Output).\npis_to_output_para(Opts, Indent, [Pi | Pis], !Output, !DidBreak) :-\n ( Pi = pi_cord(New),\n output_add_new(New, !Output),\n ( if\n !.Output ^ pos > Opts ^ o_max_line\n then\n output_newline(Indent, !Output),\n !:DidBreak = did_break\n else\n true\n )\n ; Pi = pi_nl,\n output_para_linebreak_maybe(!Output)\n ; Pi = pi_nl_hard,\n output_para_linebreak_maybe(!Output),\n output_newline(Indent, !Output)\n ; Pi = pi_start_comment,\n unexpected($file, $pred, \"comment in paragraph\")\n ; Pi = pi_nested(Type, Pretties),\n pis_to_output_nested(Opts, fail_if_overrun, Type, Indent, may_indent,\n Pretties, !.Output, MaybeOutputA, DidBreakA),\n ( MaybeOutputA = no,\n % Break at the most recent linebreak then try again.\n output_newline(Indent, !Output),\n !:DidBreak = did_break,\n pis_to_output_nested(Opts, fail_if_overrun, Type, Indent,\n may_indent, Pretties, !.Output, MaybeOutputB, DidBreakB),\n ( MaybeOutputB = no,\n pis_to_output_nested(Opts, may_break_lines, Type, Indent,\n may_indent, Pretties, !.Output, MaybeOutputC, DidBreakC),\n ( MaybeOutputC = no,\n unexpected($file, $pred, \"Won't happen\")\n ; MaybeOutputC = yes(!:Output),\n !:DidBreak = did_break_combine(DidBreakC, !.DidBreak)\n )\n ; MaybeOutputB = yes(!:Output),\n !:DidBreak = did_break_combine(DidBreakB, !.DidBreak)\n )\n ; MaybeOutputA = yes(!:Output),\n !:DidBreak = did_break_combine(DidBreakA, !.DidBreak)\n )\n ; Pi = pi_nested_oc(_, _, _, _),\n unexpected($file, $pred, \"nested_oc in paragraph\")\n ; Pi = pi_custom_indent(_, _),\n unexpected($file, $pred, \"custom in paragraph\")\n ),\n pis_to_output_para(Opts, Indent, Pis, !Output, !DidBreak).\n\n:- pred pis_to_output_nested(options::in, retry_or_commit::in,\n pretty_group_type::in, indent::in, may_indent::in, list(pretty)::in,\n output_builder::in, maybe(output_builder)::out, did_break::out) is det.\n\npis_to_output_nested(Opts, RoC, Type, Indent0, MayIndent, Pretties, !.Output,\n MaybeOutput, DidBreak) :-\n ( RoC = may_break_lines,\n pretty_to_cord_retry(Opts, MayIndent, Indent0, Type, Pretties,\n DidBreak, !Output),\n MaybeOutput = yes(!.Output)\n ; RoC = fail_if_overrun,\n ( MayIndent = may_indent,\n find_and_add_indent(Opts, no_break, Type, Pretties,\n !.Output ^ pos, Indent0, Indent)\n ; MayIndent = no_indent,\n Indent = Indent0\n ),\n InstrsBreak = map(pretty_to_pis(no_break), Pretties),\n pis_to_output(Opts, RoC, Indent, condense(InstrsBreak),\n !.Output, MaybeOutput, DidBreak)\n ).\n\n:- type may_indent\n ---> may_indent\n ; no_indent.\n\n:- pred pretty_to_cord_retry(options::in, may_indent::in, indent::in,\n pretty_group_type::in, list(pretty)::in, did_break::out,\n output_builder::in, output_builder::out) is det.\n\npretty_to_cord_retry(Opts, MayIndent, Indent0, Type, Pretties, DidBreak,\n !Output) :-\n ( MayIndent = may_indent,\n find_and_add_indent(Opts, no_break, Type, Pretties, !.Output ^ pos,\n Indent0, IndentA)\n ; MayIndent = no_indent,\n IndentA = Indent0\n ),\n\n (\n ( Type = g_expr\n ; Type = g_list\n ),\n\n InstrsNoBreak = condense(map(pretty_to_pis(no_break), Pretties)),\n % Without breaking on soft breaks, can we format all this code without\n % overrunning a line?\n pis_to_output(Opts, fail_if_overrun, IndentA, InstrsNoBreak,\n !.Output, MaybeOutput0, DidBreakA),\n ( MaybeOutput0 = yes(!:Output),\n DidBreak = DidBreakA\n ; MaybeOutput0 = no,\n % We can't so retry with soft breaks.\n ( MayIndent = may_indent,\n find_and_add_indent(Opts, no_break, Type, Pretties,\n !.Output ^ pos, Indent0, IndentB)\n ; MayIndent = no_indent,\n IndentB = Indent0\n ),\n InstrsBreak = map(pretty_to_pis(break), Pretties),\n pis_to_output(Opts, may_break_lines, IndentB, condense(InstrsBreak),\n !.Output, MaybeOutput1, DidBreakB),\n DidBreak = DidBreakB,\n ( MaybeOutput1 = no,\n unexpected($file, $pred, \"Fallback failed\")\n ; MaybeOutput1 = yes(!:Output)\n )\n )\n ; Type = g_para,\n % For paragraphs there's no retry, we insert all breaks then\n % honner them only if we've exceeded the line length.\n ( MayIndent = may_indent,\n find_and_add_indent(Opts, no_break, Type, Pretties,\n !.Output ^ pos, Indent0, IndentB)\n ; MayIndent = no_indent,\n IndentB = Indent0\n ),\n InstrsBreak = condense(map(pretty_to_pis(break), Pretties)),\n pis_to_output_para(Opts, IndentB, InstrsBreak,\n !Output, did_not_break, DidBreak)\n ).\n\n:- func did_break_combine(did_break, did_break) = did_break.\n\ndid_break_combine(did_not_break, did_not_break) = did_not_break.\ndid_break_combine(did_not_break, did_break) = did_break.\ndid_break_combine(did_break, _) = did_break.\n\n%-----------------------------------------------------------------------%\n\n:- pred find_and_add_indent(options::in, break::in,\n pretty_group_type::in, list(pretty)::in, int::in,\n indent::in, indent::out) is det.\n\nfind_and_add_indent(Opts, Break, GType, Pretties, Pos, !Indent) :-\n ( GType = g_expr\n ; GType = g_para\n ),\n find_indent(Break, Pretties, 0, FoundIndent),\n ( FoundIndent = id_default,\n ( if !.Indent ^ i_pos + Opts ^ o_indent > Pos then\n NewLevel = !.Indent ^ i_pos + Opts ^ o_indent\n else\n NewLevel = Pos + Opts ^ o_indent\n )\n ; FoundIndent = id_rel(Rel),\n NewLevel = Pos + Rel\n ),\n move_indent(NewLevel, !Indent).\nfind_and_add_indent(_, _, g_list, _, Pos, !Indent) :-\n ( if !.Indent ^ i_pos =< Pos then\n move_indent(Pos, !Indent)\n else\n true\n ).\n\n:- pred find_indent(break::in, list(pretty)::in, int::in, indent_diff::out)\n is det.\n\nfind_indent(_, [], _, id_default).\nfind_indent(Break, [P | Ps], Acc, Indent) :-\n ( P = p_unit(Cord),\n find_indent(Break, Ps, Acc + cord_string_len(Cord), Indent)\n ; P = p_spc,\n find_indent(Break, Ps, Acc + 1, Indent)\n ; P = p_empty,\n find_indent(Break, Ps, Acc, Indent)\n ;\n ( P = p_nl_hard\n ; P = p_nl_double\n ; P = p_nl_soft\n ),\n Indent = id_default,\n ( if\n all [T] (\n member(T, Ps) => not T = p_tabstop\n )\n then\n true\n else\n unexpected($file, $pred, \"Break followed by tabstop\")\n )\n ; P = p_tabstop,\n Indent = id_rel(Acc),\n ( if\n some [B] (\n member(B, Ps), ( B = p_nl_hard ; B = p_nl_soft )\n )\n then\n true\n else\n unexpected($file, $pred, \"tabstop not followed by newline\")\n )\n ; P = p_group(Type, Pretties),\n FoundBreak = single_line_len(Break, Pretties, 0),\n ( FoundBreak = found_break,\n % If there was an (honored) break in the inner group the\n % outer group has a fixed indent of \"offset\"\n (\n ( Type = g_expr\n ; Type = g_para\n ),\n Indent = id_default\n ; Type = g_list,\n Indent = id_rel(0)\n )\n ; FoundBreak = single_line(Len),\n % But if the inner group had no breaks then the search for the\n % outer group's tabstop continues.\n % We can pass Break directly since if we didn't break outside\n % the group then the group is very likely to have the same break\n % when it set-out. (Not a guarantee but a good guess).\n find_indent(Break, Ps, Acc + Len, Indent)\n )\n ; P = p_group_curly(_, _, _, _),\n % We always use the default indents for curly groups.\n Indent = id_default\n ; P = p_comment(Begin, Body),\n find_indent(Break, Body, Acc + cord_string_len(Begin), Indent)\n ).\n\n:- type single_line_len\n ---> found_break\n % When there was no break this returns the total length.\n ; single_line(int).\n\n:- func single_line_len(break, list(pretty), int) = single_line_len.\n\nsingle_line_len(_, [], Acc) = single_line(Acc).\nsingle_line_len(Break, [P | Ps], Acc) = FoundBreak :-\n ( P = p_unit(Cord),\n FoundBreak = single_line_len(Break, Ps, Acc + cord_string_len(Cord))\n ; P = p_spc,\n FoundBreak = single_line_len(Break, Ps, Acc + 1)\n ; P = p_empty,\n FoundBreak = single_line_len(Break, Ps, Acc)\n ;\n ( P = p_nl_hard\n ; P = p_nl_double\n ),\n FoundBreak = found_break\n ; P = p_nl_soft,\n ( Break = break,\n FoundBreak = found_break\n ; Break = no_break,\n FoundBreak = single_line_len(Break, Ps, Acc + 1)\n )\n ; P = p_tabstop,\n FoundBreak = single_line_len(Break, Ps, Acc)\n ; P = p_group(_, Pretties),\n FoundBreak = single_line_len(Break, Pretties ++ Ps, Acc)\n ; P = p_group_curly(_, _, _, _),\n unexpected($file, $pred, \"I don't think this makes sense\")\n ; P = p_comment(Begin, Body),\n FoundBreak = single_line_len(Break, Body, Acc +\n cord_string_len(Begin))\n ).\n\n%-----------------------------------------------------------------------%\n\n % chain_op(Ops, Input, MaybeOutput, DidBreak, !B),\n %\n % Perform each operation in Ops (so long as they return yes(_), passing\n % the output of each to the input of the next, and threading the states\n % !A and !B.\n %\n:- pred chain_op(\n list(pred(A, maybe(A), did_break)),\n A, maybe(A), did_break).\n:- mode chain_op(\n in(list(pred(in, out, out) is det)),\n in, out, out) is det.\n\nchain_op([], Cord, yes(Cord), did_not_break).\nchain_op([Op | Ops], Cord0, MaybeCord, DidBreak) :-\n Op(Cord0, MaybeCord0, DidBreakA),\n ( MaybeCord0 = no,\n MaybeCord = no,\n DidBreak = DidBreakA\n ; MaybeCord0 = yes(Cord),\n chain_op(Ops, Cord, MaybeCord, DidBreakB),\n DidBreak = did_break_combine(DidBreakA, DidBreakB)\n ).\n\n%-----------------------------------------------------------------------%\n\n:- pred move_indent(int::in, indent::in, indent::out) is det.\n\nmove_indent(NewLevel, Indent0, Indent) :-\n RelLevel = NewLevel - Indent0 ^ i_pos,\n String = Indent0 ^ i_string ++ duplicate_char(' ', RelLevel),\n Indent = indent(NewLevel, String).\n\n%-----------------------------------------------------------------------%\n\n % Use this type to build the output\n %\n:- type output_builder\n ---> output(\n output :: cord(string),\n last_line :: cord(string),\n pos :: int,\n since_break :: maybe(cord(string))\n ).\n\n:- func empty_output(int) = output_builder.\n\nempty_output(InitialPos) = output(empty, empty, InitialPos, no).\n\n:- func output_to_cord(output_builder) = cord(string).\n\noutput_to_cord(!.Output) = Cord :-\n output_end_line(!Output),\n Cord = !.Output ^ output.\n\n:- pred output_end_line(output_builder::in, output_builder::out) is det.\n\noutput_end_line(!Output) :-\n ( if is_empty(!.Output ^ output) then\n Prev = init\n else\n Prev = !.Output ^ output ++ singleton(\"\\n\")\n ),\n LastLine = trim_line(!.Output ^ last_line),\n !Output ^ output := Prev ++ singleton(LastLine),\n !Output ^ last_line := init,\n !Output ^ pos := 0.\n\n:- pred output_add_new(cord(string)::in,\n output_builder::in, output_builder::out) is det.\n\noutput_add_new(New, !Output) :-\n !Output ^ pos := !.Output ^ pos + cord_string_len(New),\n MbSinceBreak = !.Output ^ since_break,\n ( MbSinceBreak = no,\n !Output ^ last_line := !.Output ^ last_line ++ New\n ; MbSinceBreak = yes(SinceBreak),\n !Output ^ since_break := yes(SinceBreak ++ New)\n ).\n\n:- pred output_newline(indent::in,\n output_builder::in, output_builder::out) is det.\n\noutput_newline(Indent, !Output) :-\n output_end_line(!Output),\n !Output ^ last_line := singleton(Indent ^ i_string),\n MbSinceBreak = !.Output ^ since_break,\n ( MbSinceBreak = no,\n !Output ^ pos := Indent ^ i_pos\n ; MbSinceBreak = yes(SinceBreak),\n !Output ^ pos := Indent ^ i_pos + cord_string_len(SinceBreak),\n !Output ^ last_line := !.Output ^ last_line ++ SinceBreak,\n !Output ^ since_break := no\n ).\n\n % There's a potential line break so move the stuff since the last\n % linebreak into output.\n %\n:- pred output_para_linebreak_maybe(output_builder::in, output_builder::out)\n is det.\n\noutput_para_linebreak_maybe(!Output) :-\n SinceBreak = !.Output ^ since_break,\n ( SinceBreak = no,\n Since = init\n ; SinceBreak = yes(Since)\n ),\n !Output ^ since_break := yes(init),\n !Output ^ last_line := !.Output ^ last_line ++ Since.\n\n:- pred output_end_para(output_builder::in, output_builder::out) is det.\n\noutput_end_para(!Output) :-\n % Commit to the current line (same as if a linebreak is encountered).\n output_para_linebreak_maybe(!Output),\n !Output ^ since_break := no.\n\n:- pred output_start_comment(indent::in, did_break::out,\n output_builder::in, output_builder::out) is det.\n\noutput_start_comment(Indent, DidBreak, !Output) :-\n ( if is_output_line_empty(!.Output) then\n % Reset the indent without a newline.\n !Output ^ last_line := singleton(Indent ^ i_string),\n !Output ^ pos := Indent ^ i_pos,\n DidBreak = did_break\n else\n % Do a normal newline\n output_newline(Indent, !Output),\n DidBreak = did_not_break\n ).\n\n:- pred is_output_line_empty(output_builder::in) is semidet.\n\nis_output_line_empty(Output) :-\n LastLine = trim_line(Output ^ last_line),\n LastLine = \"\".\n\n:- func trim_line(cord(string)) = string.\n\ntrim_line(Line) = rstrip(append_list(list(Line))).\n\n%-----------------------------------------------------------------------%\n\n:- func cord_string_len(cord(string)) = int.\n\ncord_string_len(Cord) =\n foldl(func(S, L) = length(S) + L, Cord, 0).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\npretty_callish(Prefix, Args) = Pretty :-\n ( if\n % If the prefix is sagnificant and either...\n is_sagnificant(Prefix),\n (\n % there's only one argument being formatted or...\n Args = [_]\n ;\n % at least one argument is sagnificant...\n all [Arg] (\n member(Arg, Args),\n is_sagnificant(Arg)\n )\n )\n then\n % then add a break after the opening paren.\n MaybeBreak = [p_nl_soft]\n else\n MaybeBreak = []\n ),\n Pretty = p_expr([Prefix, p_str(\"(\")] ++ MaybeBreak ++\n [p_list(pretty_comma_seperated(Args)),\n p_str(\")\")]).\n\n:- pred is_sagnificant(pretty::in) is semidet.\n\nis_sagnificant(Pretty) :-\n SLLen = single_line_len(no_break, [Pretty], 0),\n ( SLLen = found_break\n ; SLLen = single_line(Len),\n Len > default_indent*3\n ).\n\npretty_optional_args(Prefix, []) = p_expr([Prefix]).\npretty_optional_args(Prefix, Args@[_ | _]) = pretty_callish(Prefix, Args).\n\npretty_seperated(Sep, Items) = list_join(Sep, Items).\n\npretty_comma_seperated(Items) =\n pretty_seperated([p_str(\", \"), p_nl_soft], Items).\n\nmaybe_pretty_args_maybe_prefix(_, []) = p_empty.\nmaybe_pretty_args_maybe_prefix(Prefix, [X]) = p_expr(Prefix ++ [X]).\nmaybe_pretty_args_maybe_prefix(Prefix, Xs@[_, _ | _]) =\n pretty_callish(p_expr(Prefix), Xs).\n\n%-----------------------------------------------------------------------%\n\npretty_string(Cord) = append_list(list(Cord)).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.pretty_old.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module util.pretty_old.\n%\n% Pretty printer utils.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n%-----------------------------------------------------------------------%\n:- interface.\n\n:- import_module cord.\n:- import_module list.\n%-----------------------------------------------------------------------%\n\n:- func join(cord(T), list(cord(T))) = cord(T).\n\n:- func nl = cord(string).\n\n:- func spc = cord(string).\n\n:- func semicolon = cord(string).\n\n:- func colon = cord(string).\n\n:- func comma = cord(string).\n\n:- func period = cord(string).\n\n:- func comma_spc = cord(string).\n\n:- func bang = cord(string).\n\n:- func open_curly = cord(string).\n\n:- func close_curly = cord(string).\n\n:- func open_paren = cord(string).\n\n:- func close_paren = cord(string).\n\n:- func equals = cord(string).\n\n:- func indent(int) = cord(string).\n\n:- func line(int) = cord(string).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module int.\n\n:- import_module util.mercury.\n\n%-----------------------------------------------------------------------%\n\njoin(J, Xs) = cord_list_to_cord(list_join([J], Xs)).\n\n%-----------------------------------------------------------------------%\n\nnl = singleton(\"\\n\").\n\nspc = singleton(\" \").\n\nsemicolon = singleton(\";\").\n\ncolon = singleton(\":\").\n\ncomma = singleton(\",\").\n\nperiod = singleton(\".\").\n\ncomma_spc = comma ++ spc.\n\nbang = singleton(\"!\").\n\nopen_curly = singleton(\"{\").\n\nclose_curly = singleton(\"}\").\n\nopen_paren = singleton(\"(\").\n\nclose_paren = singleton(\")\").\n\nequals = singleton(\"=\").\n\n%-----------------------------------------------------------------------%\n\nindent(N) =\n ( if N = 0 then\n init\n else\n singleton(\" \") ++ indent(N-1)\n ).\n\nline(N) = nl ++ indent(N).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/util.result.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module util.result.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% A result type, like maybe_error however it can track multiple compilation\n% errors.\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module cord.\n:- import_module list.\n:- import_module map.\n:- import_module maybe.\n\n:- import_module context.\n:- import_module util.pretty.\n\n%-----------------------------------------------------------------------%\n\n:- type result(T, E)\n ---> ok(T)\n ; errors(errors(E)).\n\n:- type result_partial(T, E)\n ---> ok(T, errors(E))\n ; errors(errors(E)).\n\n:- type errors(E) == cord(error(E)).\n\n:- type error(E)\n ---> error(\n e_context :: context,\n e_error :: E\n ).\n\n%-----------------------------------------------------------------------%\n\n:- typeclass error(E) where [\n % pretty(Error, ParaPart, ExtraPart)\n pred pretty(string::in, E::in, list(pretty)::out, list(pretty)::out) is det,\n func error_or_warning(E) = error_or_warning\n ].\n\n:- instance error(string).\n\n:- type error_or_warning\n ---> error\n ; warning.\n\n%-----------------------------------------------------------------------%\n\n:- pred add_error(context::in, E::in, errors(E)::in, errors(E)::out)\n is det.\n\n % add_errors(NewErrors, !Errors)\n %\n % Add NewErrors to !Errors.\n %\n:- pred add_errors(errors(E)::in, errors(E)::in, errors(E)::out) is det.\n\n % Add errors if the result contains any.\n %\n:- pred add_errors_from_result(result(T, E)::in,\n errors(E)::in, errors(E)::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- func error(context, E) = errors(E).\n\n:- func return_error(context, E) = result(T, E).\n\n:- func return_error_p(context, E) = result_partial(T, E).\n\n:- func maybe_to_result(context, func(string) = string, maybe_error(T)) =\n result(T, string).\n\n%-----------------------------------------------------------------------%\n\n:- pred has_fatal_errors(errors(E)::in) is semidet <= error(E).\n\n % report_errors(SourcePath, Errors, !IO).\n %\n:- pred report_errors(string::in, errors(E)::in, io::di, io::uo) is det\n <= error(E).\n\n%-----------------------------------------------------------------------%\n\n:- pred result_list_to_result(list(result(T, E))::in,\n result(list(T), E)::out) is det.\n:- func result_list_to_result(list(result(T, E))) = result(list(T), E).\n\n:- func result_map((func(T) = U), result(T, E)) = result(U, E).\n\n%-----------------------------------------------------------------------%\n\n % foldl over a list except the accumulator includes a result that must\n % be unpact before processing the next item. If mercury had monads this\n % would be bind.\n %\n:- pred foldl_result(pred(X, A, result(A, E)), list(X),\n A, result(A, E)).\n:- mode foldl_result(pred(in, in, out) is det, in, in, out) is det.\n\n % Set or update the value within a map at the given key. if the update\n % function fails then return that error.\n %\n:- pred map_set_or_update_result(func(V) = result(V, E),\n K, V, map(K, V), result(map(K, V), E)).\n:- mode map_set_or_update_result(in, in, in, in, out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- func errors_map((func(E1) = E2), errors(E1)) = errors(E2).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module string.\n\n%-----------------------------------------------------------------------%\n\nadd_error(Context, ErrorType, !Errors) :-\n Error = error(Context, ErrorType),\n !:Errors = snoc(!.Errors, Error).\n\n%-----------------------------------------------------------------------%\n\nadd_errors(NewErrors, !Errors) :-\n !:Errors = !.Errors ++ NewErrors.\n\nadd_errors_from_result(ok(_), !Errors).\nadd_errors_from_result(errors(NewErrors), !Errors) :-\n add_errors(NewErrors, !Errors).\n\n%-----------------------------------------------------------------------%\n\nerror(Context, Error) =\n singleton(error(Context, Error)).\n\nreturn_error(Context, Error) =\n errors(singleton(error(Context, Error))).\n\nreturn_error_p(Context, Error) =\n errors(singleton(error(Context, Error))).\n\nmaybe_to_result(_, _, ok(X)) = ok(X).\nmaybe_to_result(Context, Wrap, error(Msg)) =\n return_error(Context, Wrap(Msg)).\n\n%-----------------------------------------------------------------------%\n\nhas_fatal_errors(Errors) :-\n member(Error, Errors),\n error_or_warning(Error ^ e_error) = error.\n\nreport_errors(SourcePath, Errors, !IO) :-\n ErrorStrings = map(func(E) = error_to_string(SourcePath, E) ++ \"\\n\",\n list(Errors)),\n write_string(append_list(ErrorStrings), !IO).\n\n:- func error_to_string(string, error(E)) = string <= error(E).\n\nerror_to_string(SourcePath, error(Context, Error)) = String :-\n Type = error_or_warning(Error),\n ( if not is_nil_context(Context) then\n ( Type = error,\n Prefix = [p_str(context_string(SourcePath, Context)), p_str(\":\"),\n p_spc, p_tabstop]\n ; Type = warning,\n Prefix = [p_str(context_string(SourcePath, Context)), p_str(\":\"),\n p_spc, p_tabstop, p_str(\"Warning: \")]\n )\n else\n ( Type = error,\n EoW = \"Error: \"\n ; Type = warning,\n EoW = \"Warning: \"\n ),\n Prefix = [p_str(EoW), p_tabstop]\n ),\n pretty(SourcePath, Error, Para, Extra),\n ( Extra = [],\n Pretty = [p_para(Prefix ++ Para)]\n ; Extra = [_ | _],\n Pretty = [p_para(Prefix ++ Para), p_nl_hard] ++ Extra\n ),\n String = append_list(list(pretty(options(80, 2), 0, Pretty))).\n\n%-----------------------------------------------------------------------%\n\nresult_list_to_result(Results, Result) :-\n list.foldl(build_result, Results, ok([]), Result0),\n ( Result0 = ok(RevList),\n Result = ok(reverse(RevList))\n ; Result0 = errors(_),\n Result = Result0\n ).\nresult_list_to_result(Results) = Result :-\n result_list_to_result(Results, Result).\n\n:- pred build_result(result(T, E)::in,\n result(list(T), E)::in, result(list(T), E)::out) is det.\n\nbuild_result(ok(X), ok(Xs), ok([X | Xs])).\nbuild_result(ok(_), R@errors(_), R).\nbuild_result(errors(E), ok(_), errors(E)).\nbuild_result(errors(E), errors(Es0), errors(Es)) :-\n add_errors(E, Es0, Es).\n\n%-----------------------------------------------------------------------%\n\nresult_map(Func, ok(X)) = ok(Func(X)).\nresult_map(_, errors(E)) = errors(E).\n\n%-----------------------------------------------------------------------%\n\nfoldl_result(_, [], Acc, ok(Acc)).\nfoldl_result(Pred, [X | Xs], Acc0, MaybeAcc) :-\n Pred(X, Acc0, MaybeAcc1),\n ( MaybeAcc1 = ok(Acc1),\n foldl_result(Pred, Xs, Acc1, MaybeAcc)\n ; MaybeAcc1 = errors(Error),\n MaybeAcc = errors(Error)\n ).\n\n%-----------------------------------------------------------------------%\n\nmap_set_or_update_result(UpdateFn, Key, Value, !.Map, MaybeMap) :-\n ( if search(!.Map, Key, Old) then\n MaybeNew = UpdateFn(Old),\n ( MaybeNew = ok(New),\n det_update(Key, New, !Map),\n MaybeMap = ok(!.Map)\n ; MaybeNew = errors(Error),\n MaybeMap = errors(Error)\n )\n else\n set(Key, Value, !Map),\n MaybeMap = ok(!.Map)\n ).\n\n%-----------------------------------------------------------------------%\n\nerrors_map(Func, Errors) = map(error_map(Func), Errors).\n\n:- func error_map((func(E1) = E2), error(E1)) = error(E2).\n\nerror_map(Func, error(Context, E)) = error(Context, Func(E)).\n\n%-----------------------------------------------------------------------%\n\n:- instance error(string) where [\n pretty(_, S, p_words(S), []),\n error_or_warning(_) = error\n ].\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/varmap.m", "content": "%-----------------------------------------------------------------------%\n% vim: ts=4 sw=4 et\n%-----------------------------------------------------------------------%\n:- module varmap.\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% Plasma variable map data structure.\n%\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module list.\n:- import_module set.\n:- import_module string.\n\n:- import_module util.\n:- import_module util.pretty.\n\n:- type var.\n\n:- type var_or_wildcard(V)\n ---> var(V)\n ; wildcard.\n\n:- pred vow_is_var(var_or_wildcard(V)::in, V::out) is semidet.\n\n % A varmap provides name -> var and var -> name mappings. Note that\n % multiple variables can share the same name, for example on seperate\n % execution branches. In this way names are only a convenience to the\n % user.\n %\n:- type varmap.\n\n%-----------------------------------------------------------------------%\n\n:- func init = varmap.\n\n:- func get_var_name(varmap, var) = string.\n\n:- func get_var_name_no_suffix(varmap, var) = string.\n\n%-----------------------------------------------------------------------%\n%\n% This interface is constrained to one name per variable. It is used when\n% first setting up the varmap. These functions and predicates throw an\n% exception of they find multiple variables with the same name.\n%\n\n:- pred add_unique_var(string::in, var::out, varmap::in, varmap::out) is det.\n\n:- pred get_or_add_var(string::in, var::out, varmap::in, varmap::out)\n is det.\n\n:- pred add_anon_var(var::out, varmap::in, varmap::out) is det.\n\n:- pred add_n_anon_vars(int::in, list(var)::out,\n varmap::in, varmap::out) is det.\n\n:- pred search_var(varmap::in, string::in, var::out) is semidet.\n:- pred search_var_det(varmap::in, string::in, var::out) is det.\n\n%-----------------------------------------------------------------------%\n%\n% This interface allows multiple names per variable, it is used after\n% variable renaming has occured.\n%\n\n:- pred add_fresh_var(string::in, var::out, varmap::in, varmap::out) is det.\n\n:- pred search_vars(varmap::in, string::in, set(var)::out) is semidet.\n\n%-----------------------------------------------------------------------%\n\n:- pred var_or_make_var(var_or_wildcard(var)::in, var::out,\n varmap::in, varmap::out) is det.\n\n%-----------------------------------------------------------------------%\n\n:- func var_pretty(varmap, var) = pretty.\n\n:- func var_or_wild_pretty(varmap, var_or_wildcard(var)) = pretty.\n\n:- func vars_pretty(varmap, list(var)) = pretty.\n\n:- func vars_set_pretty(varmap, set(var)) = pretty.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- implementation.\n\n:- import_module int.\n:- import_module map.\n:- import_module require.\n\n%-----------------------------------------------------------------------%\n\n:- type var == int.\n\n%-----------------------------------------------------------------------%\n\nvow_is_var(var(V), V).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n\n:- type varmap\n ---> varmap(\n vm_forward :: map(var, string),\n vm_backward :: map(string, set(var)),\n vm_next_var :: var\n ).\n\n%-----------------------------------------------------------------------%\n\ninit = varmap(init, init, 0).\n\nget_var_name(Varmap, Var) = Name :-\n Name = format(\"%s_%d\", [s(get_var_name_no_suffix(Varmap, Var)), i(Var)]).\n\nget_var_name_no_suffix(Varmap, Var) = Name :-\n ( if search(Varmap ^ vm_forward, Var, Name0Prime) then\n Name = Name0Prime\n else\n Name = \"v\"\n ).\n\n%-----------------------------------------------------------------------%\n\nadd_unique_var(Name, Var, !Varmap) :-\n add_anon_var(Var, !Varmap),\n add_forward_name(Name, Var, !Varmap),\n ( if search(!.Varmap ^ vm_backward, Name, _) then\n unexpected($file, $pred, \"Variable already exists\")\n else\n det_insert(Name, make_singleton_set(Var), !.Varmap ^ vm_backward,\n Backward),\n !Varmap ^ vm_backward := Backward\n ).\n\nget_or_add_var(Name, Var, !Varmap) :-\n ( if search_var(!.Varmap, Name, VarPrime) then\n Var = VarPrime\n else\n add_unique_var(Name, Var, !Varmap)\n ).\n\nadd_anon_var(Var, !Varmap) :-\n Var = !.Varmap ^ vm_next_var,\n !Varmap ^ vm_next_var := Var + 1.\n\nadd_n_anon_vars(N, Vars, !Varmap) :-\n ( if N < 1 then\n Vars = []\n else\n add_n_anon_vars(N - 1, Vars0, !Varmap),\n add_anon_var(Var, !Varmap),\n Vars = [Var | Vars0]\n ).\n\nsearch_var(Varmap, Name, Var) :-\n search_vars(Varmap, Name, Vars),\n ( if singleton_set(VarPrime, Vars) then\n Var = VarPrime\n else\n unexpected($file, $pred,\n format(\"%s is ambigious\", [s(Name)]))\n ).\n\nsearch_var_det(Varmap, Name, Var) :-\n ( if search_var(Varmap, Name, VarPrime) then\n Var = VarPrime\n else\n unexpected($file, $pred, \"Var not found\")\n ).\n\n%-----------------------------------------------------------------------%\n\nadd_fresh_var(Name, Var, !Varmap) :-\n add_anon_var(Var, !Varmap),\n add_forward_name(Name, Var, !Varmap),\n ( if search(!.Varmap ^ vm_backward, Name, Vars0) then\n Vars = set.insert(Vars0, Var)\n else\n Vars = make_singleton_set(Var)\n ),\n map.set(Name, Vars, !.Varmap ^ vm_backward, Backward),\n !Varmap ^ vm_backward := Backward.\n\nsearch_vars(Varmap, Name, Var) :-\n search(Varmap ^ vm_backward, Name, Var).\n\n%-----------------------------------------------------------------------%\n\nvar_or_make_var(var(Var), Var, !Varmap).\nvar_or_make_var(wildcard, Var, !Varmap) :-\n add_anon_var(Var, !Varmap).\n\n%-----------------------------------------------------------------------%\n\n:- pred add_forward_name(string::in, var::in, varmap::in, varmap::out)\n is det.\n\nadd_forward_name(Name, Var, !Varmap) :-\n det_insert(Var, Name, !.Varmap ^ vm_forward, Forward),\n !Varmap ^ vm_forward := Forward.\n\n%-----------------------------------------------------------------------%\n\nvar_pretty(Varmap, Var) = p_str(get_var_name(Varmap, Var)).\n\nvar_or_wild_pretty(Varmap, var(Var)) = var_pretty(Varmap, Var).\nvar_or_wild_pretty(_, wildcard) = p_str(\"_\").\n\nvars_pretty(Varmap, Vars) =\n p_list((pretty_comma_seperated(map(var_pretty(Varmap), Vars)))).\n\nvars_set_pretty(Varmap, Vars) =\n vars_pretty(Varmap, to_sorted_list(Vars)).\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "src/write_interface.m", "content": "%-----------------------------------------------------------------------%\n% Write a Plasma interface file\n% vim: ts=4 sw=4 et\n%\n% Copyright (C) Plasma Team\n% Distributed under the terms of the MIT License see ../LICENSE.code\n%\n% This module provides the code for writing out an interface file.\n%\n%-----------------------------------------------------------------------%\n:- module write_interface.\n%-----------------------------------------------------------------------%\n\n:- interface.\n\n:- import_module io.\n:- import_module maybe.\n:- import_module string.\n\n:- import_module core.\n\n:- pred write_interface(string::in, core::in, maybe_error::out,\n io::di, io::uo) is det.\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n:- implementation.\n\n:- import_module cord.\n:- import_module list.\n:- import_module pair.\n\n:- import_module common_types.\n:- import_module core.function.\n:- import_module core.pretty.\n:- import_module core.types.\n:- import_module core.resource.\n:- import_module q_name.\n:- import_module util.\n:- import_module util.my_io.\n:- import_module util.pretty.\n\n%-----------------------------------------------------------------------%\n\nwrite_interface(Filename, Core, Result, !IO) :-\n PrettyStr = pretty_str([pretty_interface(Core)]),\n write_temp_and_move(open_output, close_output,\n (pred(File::in, ok::out, IO0::di, IO::uo) is det :-\n io.write_string(File, PrettyStr, IO0, IO)\n ), Filename, Result, !IO).\n\n:- func pretty_interface(core) = pretty.\n\npretty_interface(Core) = Pretty :-\n ModuleName = q_name_to_string(module_name(Core)),\n ExportedResources = core_all_exported_resources(Core),\n ExportedTypes = core_all_exported_types(Core),\n ExportedFuncs = core_all_exported_functions(Core),\n Pretty = p_list([\n p_str(\"// Plasma interface file\"), p_nl_hard,\n p_str(\"module\"), p_spc, p_str(ModuleName), p_nl_double] ++\n condense(map(pretty_resource_interface(Core), ExportedResources)) ++\n condense(map(pretty_type_interface(Core), ExportedTypes)) ++\n condense(map(pretty_func_interface(Core), ExportedFuncs))).\n\n:- func pretty_resource_interface(core, pair(resource_id, resource)) =\n list(pretty).\n\npretty_resource_interface(Core, _ - R) =\n [resource_interface_pretty(Core, R), p_nl_double].\n\n:- func pretty_type_interface(core, pair(type_id, user_type)) = list(pretty).\n\npretty_type_interface(Core, _ - Type) = Pretty :-\n Pretty = [type_interface_pretty(Core, Type), p_nl_double].\n\n:- func pretty_func_interface(core, pair(func_id, function)) = list(pretty).\n\npretty_func_interface(Core, _ - Func) = Pretty :-\n Pretty = [p_expr(func_decl_pretty(Core, Func)), p_nl_double].\n\n%-----------------------------------------------------------------------%\n%-----------------------------------------------------------------------%\n" }, { "path": "template.mk", "content": "#\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# vim: noet sw=4 ts=4 ft=make\n#\n\n# Basic configuration\n# ===================\n# \n# To configure Plasma copy this file `template.mk` to `build.mk` and then\n# modify it there.\n#\n# Sensible defaults are already set by defaults.mk, so to change them\n# uncomment and modify the settings in this file to override those defaults.\n#\n\n# Where programs are installed (PREFIX options show system/user, but any\n# path is okay)\n# PREFIX=/usr/local\n# PREFIX=~/.local\n# BINDIR=$(PREFIX)/bin\n# DOCDIR=$(PREFIX)/share/doc/plasma\n\n# How the Mercury compiler should be called. You may need to adjust this if\n# it is not in your path.\n# MMC_MAKE=mmc --make -j$(JOBS) --use-grade-subdirs\n\n# The number of parallel jobs the Mercury compiler should spawn (set\n# automatically for the Mercury code on systems with `nproc`).\n# JOBS=8\n\n# How the C compiler should be called. gcc and clang should both work.\n# Note that Mercury has its own configuration for its C backend, which is\n# not, and must not be changed here.\n# CC=gcc\n# CXX=g++\n\n# Some basic build flags to get things working for either C or C++\n# C_CXX_FLAGS_BASE=-D_POSIX_C_SOURCE=200809L -D_DEFAULT_SOURCE\n# C_ONLY_FLAGS=-std=c99\n# CXX_ONLY_FLAGS=-std=c++11 -fno-rtti -fno-exceptions\n\n# gcc and probably clang support dependency tracking. If your compiler\n# doesn't uncomment the 2nd line.\n# DEPDIR=.dep\n# DEPFLAGS=-MT $@ -MMD -MP -MF $(DEPDIR)/$(basename $*).Td\n\n# How to install programs, specify here the owner, group and mode of\n# installed files.\n# INSTALL=install\n# INSTALL_STRIP=install -s\n# INSTALL_DIR=install -d\n\n# How to call asciidoc (optional). A full path or any flags here won't work\n# without other changes to the makefile.\n# ASCIIDOC=asciidoc\n\n# How to call clang-format (optional)\n# CLANGFORMAT=clang-format\n\n# How to call indent (optional)\n# INDENT=indent\n\n\n# Build type options (normal, optimised, debugging)\n# -------------------------------------------------\n#\n# The following settings are closely related and therefore we provide\n# suggestions in groups, depending on what type of build you want.\n#\n# Note that there are also some build parameters in src/Mercury.options\n#\n# This is a suitable build for development. It has assertions enabled in\n# the C code some of which are slow, so they shouldn't be used for\n# performance measurement. Comment it out to use one of the optimised\n# builds below.\n\n# C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O1 -Wall\n# BUILD_TYPE=rel\n\n# Uncomment to add fatal warnings and runtime assertions. Also see the\n# corresponding code to uncomment in src/Mercury.options\n#\n# C_CXX_FLAGS+=-Werror -DDEBUG -DPZ_DEV\n# BUILD_TYPE=dev\n\n# You can uncomment _at most one_ of the following sets of options, or write\n# your own.\n\n# Enable C and Mercury debugging.\n# MCFLAGS+=--grade asm_fast.gc.decldebug.stseg\n# C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O0 -DDEBUG -g -DPZ_DEV\n# BUILD_TYPE=dev\n\n# Enable static linking\n# MCFLAGS+=--mercury-linkage static\n# C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O2\n# BUILD_TYPE=rel\n\n# Enable optimisation,\n# Remember to comment-out the development build options above.\n# MCFLAGS+=-O4 --intermodule-optimisation\n# C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O3\n# BUILD_TYPE=rel\n\n# Enable both static linking and optimisation\n# Remember to comment-out the development build options above.\n# MCFLAGS+=-O4 --intermodule-optimisation \\\n# --mercury-linkage static\n# C_CXX_FLAGS=$(C_CXX_FLAGS_BASE) -O3\n# BUILD_TYPE=rel\n\n# Enable Mercury profiling\n# MCFLAGS+=--grade asm_fast.gc.profdeep.stseg\n\n# Extra features\n# --------------\n#\n# These can be uncommented to add extra features of interest to developers.\n\n# Tracing of the type checking/inference solver.\n# MCFLAGS+=--trace-flag typecheck_solve\n\n" }, { "path": "tests/.gitignore", "content": "_build\n*.out\n*.outs\n*.pi\n*.pz\n*.pzo\n*.dir\n" }, { "path": "tests/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[hello]\ntype = program\nmodules = [Hello]\n\n" }, { "path": "tests/README.md", "content": "\nPlasma Test Suite\n=================\n\nTest suite organisation\n-----------------------\n\nTests are organised into the following directories:\n\n * **build**: Test the build system.\n * **builtins**: Test builtin functions.\n * **ffi**: Test the foreign function interface.\n * **language**: Test language features (syntax and semantics).\n * **library**: Test library code.\n * **modules**: Test the module system.\n * **runtime**: Test runtime features like the GC.\n\nPlus the **examples** directory from the root of the project.\n\nFor more information about the test suite please see the documentation at\nhttps://plasmalang.org/docs/dev_testing.html\n\n" }, { "path": "tests/build/bad_file_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\nbase = toml = file\n" }, { "path": "tests/build/bad_file_1.exp", "content": "bad_file_1.build:6: Unrecognised TOML line\n" }, { "path": "tests/build/bad_file_2.exp", "content": "not_exist.build: can't open input file: No such file or directory\n" }, { "path": "tests/build/bad_file_2.test", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n# PLZTEST build_args --rebuild --build-file not_exist.build\n" }, { "path": "tests/build/bad_file_3.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n[good_name]\ntype = program\nmodules = [ AMod ]\n\n# Duplicate name\n[good_name]\ntype = program\nmodules = [ AMod ]\n\n" }, { "path": "tests/build/bad_file_3.exp", "content": "bad_file_3.build:11: Duplicate table: good_name\n" }, { "path": "tests/build/bad_file_4.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n[]\ntype = program\n\n[abc!!!def]\ntype = program\n\n[good_name1]\ntype = program\n# no module list\n\n[good_name2]\ntype = program\n# bad module list\nmodules = NotAList\n\n[good_name4]\ntype = program\nmodules = [ bad!!Name, another!bad!name ]\n\n" }, { "path": "tests/build/bad_file_4.exp", "content": "bad_file_4.build:6: Invalid name ''\nbad_file_4.build:9: Invalid name 'abc!!!def'\nbad_file_4.build:12: Key not found 'modules'\nbad_file_4.build:19: Invalid modules field: Value is not an array\nbad_file_4.build:23: Invalid modules field: 'bad!!Name' Illegal identifier\nbad_file_4.build:23: Invalid modules field: 'another!bad!name' Illegal\n identifier\n" }, { "path": "tests/build/bad_module_name.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n# PLZTEST build_args --rebuild --build-file bad_module_name.build quack!!bad, GoodName\n# PLZTEST output stderr \n\n\n" }, { "path": "tests/build/bad_module_name.exp", "content": "Plasma program name 'quack!!bad,' is invalid: Illegal identifier.\n" }, { "path": "tests/build/bad_module_name_2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n[bad_module_name_2]\ntype = program\n# When the module name doesn't match by only case or underscores the\n# compiler would crash.\nmodules = [BADMODULENAME2]\n\n" }, { "path": "tests/build/bad_module_name_2.exp", "content": "bad_module_name_2.p:10: The module name from the source file 'BadModuleName2'\n does not match the module name from the BUILD.plz file\n 'BADMODULENAME2'\n" }, { "path": "tests/build/bad_module_name_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n// When a program's module doesn't match the one listed in the build file it\n// causes the build program to crash.\n\nmodule BadModuleName2 \n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"Test!\\n\")\n \n return 0\n}\n\n" }, { "path": "tests/build/dup_module_name.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n[dup_module_name]\ntype = program\n# List a module name twice.\nmodules = [DupModuleName, SingleModuleName, DupModuleName, NameAgain, NameAgain, NameAgain]\n\n" }, { "path": "tests/build/dup_module_name.exp", "content": "dup_module_name.build:6: The following modules were listed more than once:\n 'DupModuleName', 'NameAgain'\n" }, { "path": "tests/build/dup_module_name_2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n[dup_module_name_2]\ntype = program\n# List a module name twice, this time with a case or underscore difference.\n# THis will be caught when the compiler checks that it got the right module.\nmodules = [DupModuleName2, Dup_ModuleName2]\n\n" }, { "path": "tests/build/dup_module_name_2.exp", "content": "dup_module_name_2.p:10: The module name from the source file 'DupModuleName2'\n does not match the module name from the BUILD.plz file\n 'Dup_ModuleName2'\n" }, { "path": "tests/build/dup_module_name_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n// When a program's module doesn't match the one listed in the build file it\n// causes the build program to crash.\n\nmodule DupModuleName2 \n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"Test!\\n\")\n \n return 0\n}\n\n" }, { "path": "tests/build/extra_module.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ExtraModule\n\nThis is an extra module with bad syntax, it checks that the tests here don't\npick it up by mistake.\n\n" }, { "path": "tests/build/file_in_other_program.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# Test that including a file that's part of a different program has the\n# correct error message.\n\n[file_in_other_program]\ntype = program\nmodules = [ FileInOtherProgram ]\n\n[other_program]\ntype = program\nmodules = [ OtherProgram ]\n" }, { "path": "tests/build/file_in_other_program.expish", "content": "file_in_other_program.p:9: The module OtherProgram can't be included because\n it is not listed in all the build file's module\n lists that include module FileInOtherProgram\n" }, { "path": "tests/build/file_in_other_program.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule FileInOtherProgram\n\nimport OtherProgram\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"Hello\\n\")\n return 0\n}\n\n" }, { "path": "tests/build/include_file_nobuild.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n[include_file_nobuild]\ntype = program\nmodules = [IncludeFileNobuild, NotExist3]\n\n" }, { "path": "tests/build/include_file_nobuild.exp", "content": "include_file_nobuild.build:8: Can't find source for NotExist3 module\n" }, { "path": "tests/build/include_file_nobuild.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule IncludeNofileNobuild\n\nimport NotExist3\n\nentrypoint func main() uses IO -> Int {\n return 0\n}\n" }, { "path": "tests/build/include_nofile_build.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n[include_nofile_build]\ntype = program\nmodules = [IncludeNofileBuild, NotExist2]\n\n" }, { "path": "tests/build/include_nofile_build.exp", "content": "include_nofile_build.build:8: Can't find source for NotExist2 module\n" }, { "path": "tests/build/include_nofile_build.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule IncludeNofileBuild\n\nimport NotExist2\n\nentrypoint func main() uses IO -> Int {\n return 0\n}\n" }, { "path": "tests/build/include_nofile_nobuild.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[include_nofile_nobuild]\ntype = program\nmodules = [IncludeNofileNobuild]\n\n" }, { "path": "tests/build/include_nofile_nobuild.expish", "content": "include_nofile_nobuild.p:9: The module NotExist1 can't be included because\n it is not listed in all the build file's module\n lists that include module IncludeNofileNobuild\n" }, { "path": "tests/build/include_nofile_nobuild.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule IncludeNofileNobuild\n\nimport NotExist1\n\nentrypoint func main() uses IO -> Int {\n return 0\n}\n" }, { "path": "tests/build/options_compiler_01.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[options_compiler_01]\ntype = program\nmodules = [ OptionsCompiler01 ]\ncompiler_opts = \"--no-simplify\"\n\n" }, { "path": "tests/build/options_compiler_01.exp", "content": "Hello world\n" }, { "path": "tests/build/options_compiler_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule OptionsCompiler01\n\nentrypoint\nfunc hello() uses IO -> Int {\n print!(\"Hello world\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/build/options_compiler_02.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n[options_compiler_02]\ntype = program\nmodules = [ OptionsCompiler02 ]\ncompiler_opts = \"--nonexistant-option\"\n\n" }, { "path": "tests/build/options_compiler_02.exp", "content": "Error processing command line options: unrecognized option `--nonexistant-option'\n" }, { "path": "tests/build/options_compiler_02.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule OptionsCompiler02\n\nentrypoint\nfunc hello() uses IO -> Int {\n print!(\"Hello world\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/build/options_compiler_03.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n# This test asks the build system to build the same module with different\n# settings, it should fail.\n\n[options_compiler_03a]\ntype = program\nmodules = [ OptionsCompiler03a, OptionsCompiler03 ]\ncompiler_opts = \"--no-simplify\"\n\n[options_compiler_03b]\ntype = program\nmodules = [ OptionsCompiler03b, OptionsCompiler03 ]\n\n" }, { "path": "tests/build/options_compiler_03.exp", "content": "options_compiler_03.build:11: Flags set for the same module in different\n programs do not match\n" }, { "path": "tests/build/other_program.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule OtherProgram\n\nentrypoint\nfunc other_main() uses IO -> Int {\n print!(\"Other Hello\\n\")\n return 0\n}\n\n" }, { "path": "tests/builtins/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[builtin_01]\ntype = program\nmodules = [Builtin01]\n\n[builtin_02_int]\ntype = program\nmodules = [Builtin02Int]\n\n[builtin_03_bool]\ntype = program\nmodules = [Builtin03Bool]\n\n[builtin_04_string]\ntype = program\nmodules = [Builtin04String]\n\n[builtin_05_list]\ntype = program\nmodules = [Builtin05List]\n\n" }, { "path": "tests/builtins/builtin_01.exp", "content": "Map result: None\nMap result: Some(24)\nPrint works, duh\nsetenv result: True\n" }, { "path": "tests/builtins/builtin_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Builtin01\n\n/*\n * This test should be kept up-to-date with the documentation for the\n * builtins in docs/plasma_ref.txt\n */\nentrypoint\nfunc main() uses IO -> Int {\n test_maybe!()\n\n test_misc!()\n\n return 0\n}\n\n/* ****************************************** */\n\nfunc test_maybe() uses IO {\n var a = None\n var b = Some(23)\n func maybe_str(m : Maybe(String)) -> String {\n return match(m) {\n None -> \"None\"\n Some(var x) -> \"Some(\" ++ x ++ \")\"\n }\n }\n\n print!(\"Map result: \" ++\n maybe_str(maybe_map(int_to_string, maybe_map(plus1, a))) ++\n \"\\n\") \n print!(\"Map result: \" ++\n maybe_str(maybe_map(int_to_string, maybe_map(plus1, b))) ++\n \"\\n\")\n}\n\nfunc maybe_map(f : func('a) -> 'b, m : Maybe('a)) -> Maybe('b) {\n return match(m) {\n None -> None\n Some(var x) -> Some(f(x))\n }\n}\n\nfunc plus1(x : Int) -> Int {\n return x + 1\n}\n\n/* ****************************************** */\n\n// We can name some resources\nresource A from IO\nresource B from Time\nresource C from Environment\n\n\nfunc test_misc() uses IO {\n print!(\"Print works, duh\\n\")\n\n // By using a function we test that `IOResult` can be named.\n func sink_ioresult(rl : func () uses IO -> IOResult(String)) uses IO {\n // Don't actually do it because the test doesn't read any standard\n // input. We have other tests for that.\n if (False) {\n match (rl!()) {\n Ok(_) -> {}\n EOF -> {}\n }\n } else {}\n }\n // The readline function matches\n sink_ioresult!(readline)\n \n\n _ = Builtin.set_parameter!(\"nothing\", 2)\n _, _ = Builtin.get_parameter!(\"heap_usage\")\n\n func do_setenv() uses Environment -> Bool {\n // Wrap in this function to test that it uses the right resource.\n return setenv!(\"Foo\", \"Bar\")\n }\n var r = do_setenv!()\n print!(\"setenv result: \" ++ bool_to_string(r) ++ \"\\n\")\n \n func do_gettimeofday() uses Time {\n _, _, _ = Builtin.gettimeofday!()\n }\n do_gettimeofday!()\n\n if (False) {\n Builtin.die(\"Die!\")\n } else {}\n}\n\n// Test that we can define a function with the same name as a hidden builtin\nfunc die() uses IO {\n print!(\"I'm dead\\n\") // not really.\n}\n\n" }, { "path": "tests/builtins/builtin_02_int.exp", "content": "int_add(5, 3) = 8\nint_sub(5, 3) = 2\nint_mul(5, 3) = 15\nint_div(36, 7) = 5\nint_mod(36, 7) = 1\nint_minus(23) = -23\nint_leftshift(5, 3) = 40\nint_rightshift(37, 2) = 9\nint_and(15, 28) = 12\nint_or(15, 28) = 31\nint_xor(15, 28) = 19\nint_comp(5) = -6\nint_gt(3, 5) = False\nint_lt(3, 5) = True\nint_gteq(3, 5) = False\nint_lteq(3, 5) = True\nint_eq(3, 5) = False\nint_neq(3, 5) = True\n" }, { "path": "tests/builtins/builtin_02_int.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Builtin02Int\n\n/*\n * This test should be kept up-to-date with the documentation for the\n * builtins in docs/plasma_ref.txt\n */\nentrypoint\nfunc main() uses IO -> Int {\n // Tests for integer oeprators are in operators.p\n\n // We can name the Int type.\n func foo(v : Int) -> Int {\n return v * 42\n }\n\n print!(\"int_add(5, 3) = \" ++\n int_to_string(Builtin.int_add(5, 3)) ++ \"\\n\")\n print!(\"int_sub(5, 3) = \" ++\n int_to_string(Builtin.int_sub(5, 3)) ++ \"\\n\")\n print!(\"int_mul(5, 3) = \" ++\n int_to_string(Builtin.int_mul(5, 3)) ++ \"\\n\")\n print!(\"int_div(36, 7) = \" ++\n int_to_string(Builtin.int_div(36, 7)) ++ \"\\n\")\n print!(\"int_mod(36, 7) = \" ++\n int_to_string(Builtin.int_mod(36, 7)) ++ \"\\n\")\n print!(\"int_minus(23) = \" ++\n int_to_string(Builtin.int_minus(23)) ++ \"\\n\")\n\n // Builtin Int functions that are not operators, including\n // int_to_string. \n print!(\"int_leftshift(5, 3) = \" ++\n int_to_string(Builtin.int_lshift(5, 3)) ++ \"\\n\")\n print!(\"int_rightshift(37, 2) = \" ++\n int_to_string(Builtin.int_rshift(37, 2)) ++ \"\\n\")\n print!(\"int_and(15, 28) = \" ++\n int_to_string(Builtin.int_and(15, 28)) ++ \"\\n\")\n print!(\"int_or(15, 28) = \" ++\n int_to_string(Builtin.int_or(15, 28)) ++ \"\\n\")\n print!(\"int_xor(15, 28) = \" ++\n int_to_string(Builtin.int_xor(15, 28)) ++ \"\\n\")\n print!(\"int_comp(5) = \" ++ \n int_to_string(Builtin.int_comp(5)) ++ \"\\n\")\n\n print!(\"int_gt(3, 5) = \" ++\n bool_to_string(Builtin.int_gt(3, 5)) ++ \"\\n\")\n print!(\"int_lt(3, 5) = \" ++\n bool_to_string(Builtin.int_lt(3, 5)) ++ \"\\n\")\n print!(\"int_gteq(3, 5) = \" ++\n bool_to_string(Builtin.int_gteq(3, 5)) ++ \"\\n\")\n print!(\"int_lteq(3, 5) = \" ++\n bool_to_string(Builtin.int_lteq(3, 5)) ++ \"\\n\")\n print!(\"int_eq(3, 5) = \" ++\n bool_to_string(Builtin.int_eq(3, 5)) ++ \"\\n\")\n print!(\"int_neq(3, 5) = \" ++\n bool_to_string(Builtin.int_neq(3, 5)) ++ \"\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/builtins/builtin_03_bool.exp", "content": "test: False and True\nand: False\nor: True\nnot: False\n" }, { "path": "tests/builtins/builtin_03_bool.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Builtin03Bool\n\n/*\n * This test should be kept up-to-date with the documentation for the\n * builtins in docs/plasma_ref.txt\n */\nentrypoint\nfunc main() uses IO -> Int {\n\n // Show that we can name the type and constructor.\n func do_a_bool(a : Bool) -> Bool {\n return not a and True\n }\n print!(\"test: \" ++ bool_to_string(do_a_bool(True)) ++ \" and \" ++\n bool_to_string(do_a_bool(False)) ++ \"\\n\")\n\n // Let's use some builtin functions, but as higher-order values.\n func do_test(name : String, f : func(Bool, Bool) -> Bool) uses IO {\n print!(name ++ \": \" ++ bool_to_string(f(True, False)) ++ \"\\n\")\n }\n do_test!(\"and\", Builtin.bool_and)\n do_test!(\"or\", Builtin.bool_or)\n print!(\"not: \" ++ bool_to_string(Builtin.bool_not(True)) ++ \"\\n\")\n \n return 0\n}\n\n" }, { "path": "tests/builtins/builtin_04_string.exp", "content": "aaabbb\nabc123\nworld == world = True\ncl1 is Whitespace\ncl2 is Whitespace\nCheck codepoint_to_number('a') = 97\nCheck int_to_codepoint(112) = p\n" }, { "path": "tests/builtins/builtin_04_string.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Builtin04String\n\n/*\n * This test should be kept up-to-date with the documentation for the\n * builtins in docs/plasma_ref.txt\n */\nentrypoint\nfunc main() uses IO -> Int {\n\n // Show that we can name the type and constructor.\n func name_some_types(s : String, c : CodePoint, cc : CodepointCategory) ->\n StringPos\n {\n return string_begin(s)\n }\n\n // Concat\n print!(\"aaa\" ++ \"bbb\" ++ \"\\n\")\n print!(Builtin.string_concat(\"abc\", \"123\") ++ \"\\n\")\n\n // string_begin and string_end\n var s = \"Hello world\"\n var begin = string_begin(s)\n var end = string_end(s)\n\n // Strpos stuff.\n var moved = repeat(6, strpos_forward, begin)\n var moved2 = strpos_backward(moved)\n\n // substring\n var s2 = string_substring(moved, end)\n\n // String equals\n print!(\"world == \" ++ s2 ++ \" = \" ++\n bool_to_string(string_equals(\"world\", s2)) ++ \"\\n\")\n\n var mc1 = strpos_prev(moved)\n var mc2 = strpos_next(moved2)\n\n match (mc1) {\n None -> {\n print!(\"Failed to get prev character from moved\\n\")\n }\n Some(var c1) -> {\n match (mc2) {\n None -> {\n print!(\"Failed to get next character from moved2\\n\")\n }\n Some(var c2) -> {\n // codepoint category \n var cl1 = codepoint_category(c1)\n var cl2 = codepoint_category(c2)\n print!(\"cl1 is \" ++ category_string(cl1) ++ \"\\n\")\n print!(\"cl2 is \" ++ category_string(cl2) ++ \"\\n\")\n }\n }\n }\n }\n\n print!(\"Check codepoint_to_number('a') = \" ++\n int_to_string(codepoint_to_number(\"a\")) ++ \"\\n\")\n print!(\"Check int_to_codepoint(112) = \" ++\n codepoint_to_string(Builtin.int_to_codepoint(112)) ++ \"\\n\")\n \n return 0\n}\n\nfunc category_string(c : CodepointCategory) -> String {\n return match (c) {\n Whitespace -> \"Whitespace\"\n Other -> \"Other\"\n }\n}\n\nfunc repeat(num : Int, f : func('x) -> 'x, x : 'x) -> 'x {\n if (num > 0) {\n return repeat(num - 1, f, f(x))\n } else {\n return x\n }\n}\n\n" }, { "path": "tests/builtins/builtin_05_list.exp", "content": "The final list is: 1, 2, 3, 4, 5, 6\n" }, { "path": "tests/builtins/builtin_05_list.p", "content": "\n/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Builtin05List\n\n/*\n * This test should be kept up-to-date with the documentation for the\n * builtins in docs/plasma_ref.txt\n */\nentrypoint\nfunc main() uses IO -> Int {\n\n // Nil can be spelt.\n var nil1 = Builtin.list_nil()\n var nil2 = []\n\n // Cons can be spelt\n var list1 = [1, 2, 3]\n var list2 = Builtin.list_cons(4, Builtin.list_cons(5, [6]))\n\n // Constrain the types.\n var final_list = concat([list1, nil1, list2, nil2])\n\n print!(\"The final list is: \" ++ \n join(\", \", map(int_to_string, final_list)) ++ \"\\n\")\n\n return 0\n}\n\nfunc append(l1 : List('t), l2 : List('t)) -> List('t) {\n return match (l1) {\n [] -> l2\n [var x | var xs] -> [x | append(xs, l2)]\n }\n}\n\nfunc concat(l : List(List('t))) -> List('t) {\n return match (l) {\n [] -> []\n [var x | var xs] -> append(x, concat(xs)) \n }\n}\n\nfunc join(j : String, l : List(String)) -> String {\n func join2(x : String, xs : List(String)) -> String {\n return match (xs) {\n [] -> x\n [var y | var ys] -> x ++ j ++ join2(y, ys)\n }\n }\n\n return match (l) {\n [] -> \"\"\n [var x | var xs] -> join2(x, xs)\n }\n}\n\nfunc map(f : func('x) -> 'y, l : List('x)) -> List('y) {\n return match (l) {\n [] -> []\n [var x | var xs] -> [f(x) | map(f, xs)]\n }\n}\n\n" }, { "path": "tests/builtins/builtin_not_found.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[builtin_not_found]\ntype = program\nmodules = [BuiltinNotFound]\n\n" }, { "path": "tests/builtins/builtin_not_found.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown symbol: string_concat\nContext: ../builtin_not_found.p:13\nplzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nplzc file: pre.from_ast.m\n" }, { "path": "tests/builtins/builtin_not_found.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule BuiltinNotFound\n\nentrypoint\nfunc main() uses IO -> Int {\n // string_concat is a builtin, but it's not imported so this should\n // generate a compiler error.\n print!(string_concat(\"abc\", \"def\"))\n\n return 0\n}\n\n" }, { "path": "tests/ffi/.gitignore", "content": "*.o\n*.so\n" }, { "path": "tests/ffi/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# This is a Plasma build file, it will tell Plasma about the programs in\n# this directory and what modules they're made from.\n#\n\n[import_function]\ntype = program\nmodules = [ImportFunction]\nc_sources = [import_function.cpp]\n\n[import_from_two_modules]\ntype = program\nmodules = [ImportFromTwoModules1, ImportFromTwoModules2]\nc_sources = [import_from_two_modules.cpp]\n\n[import_two_sources]\ntype = program\nmodules = [ImportTwoSources]\nc_sources = [import_two_sources.cpp, import_shared_module.cpp]\n\n[import_shared_module]\ntype = program\nmodules = [ImportSharedModule]\nc_sources = [import_shared_module.cpp]\n\n" }, { "path": "tests/ffi/import_from_two_modules.cpp", "content": "/*\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n#include \n#include \n#include \n\n#include \"../../runtime/pz_common.h\"\n#include \"../../runtime/pz_foreign.h\"\n#include \"../../runtime/pz_generic_run.h\"\n\n#include \"import_function.h\"\n\nusing namespace pz;\n\nunsigned bar(void * stack_, unsigned sp)\n{\n printf(\"Hi mum\\n\");\n return sp;\n}\n\nunsigned my_getpid(void * stack_, unsigned sp)\n{\n StackValue * stack = reinterpret_cast(stack_);\n stack[++sp].u32 = getpid();\n return sp;\n}\n\n" }, { "path": "tests/ffi/import_from_two_modules.exp", "content": "Hello world\nMy pid didn't change\nDoing another foreign call\nHi mum\ndone\n" }, { "path": "tests/ffi/import_from_two_modules.h", "content": "/*\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n#ifndef IMPORT_FROM_TWO_MODULES_H\n#define IMPORT_FROM_TWO_MODULES_H\n\nunsigned bar(void * stack_, unsigned sp);\nunsigned my_getpid(void * stack_, unsigned sp);\n\n#endif /* ! IMPORT_FROM_TWO_MODULES_H */\n\n" }, { "path": "tests/ffi/import_from_two_modules_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ImportFromTwoModules1 \n\nimport ImportFromTwoModules2 as I2M2\n\npragma foreign_include(\"import_from_two_modules.h\")\n\nfunc getpid() -> Int\n foreign(my_getpid)\n\nentrypoint\nfunc hello() uses IO -> Int {\n print!(\"Hello world\\n\")\n\n var pid = getpid!()\n print!(\"# My pid is \" ++ int_to_string(pid) ++ \"\\n\")\n\n var pid2 = getpid!()\n if (pid == pid2) {\n print!(\"My pid didn't change\\n\")\n } else {\n print!(\"My pid changed, that's weird\\n\")\n }\n\n I2M2.test!()\n\n return 0\n}\n\n" }, { "path": "tests/ffi/import_from_two_modules_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ImportFromTwoModules2 \n\npragma foreign_include(\"import_from_two_modules.h\")\n\nfunc bar() uses IO\n foreign(bar)\n\nexport\nfunc test() uses IO {\n print!(\"Doing another foreign call\\n\")\n bar!()\n print!(\"done\\n\")\n}\n\n" }, { "path": "tests/ffi/import_function.cpp", "content": "/*\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n#include \n#include \n#include \n\n#include \"../../runtime/pz_common.h\"\n#include \"../../runtime/pz_foreign.h\"\n#include \"../../runtime/pz_generic_run.h\"\n\n#include \"import_function.h\"\n\nusing namespace pz;\n\nunsigned foo(void * stack_, unsigned sp)\n{\n printf(\"Hi mum\\n\");\n return sp;\n}\n\nunsigned my_getpid(void * stack_, unsigned sp)\n{\n StackValue * stack = reinterpret_cast(stack_);\n stack[++sp].u32 = getpid();\n return sp;\n}\n\n" }, { "path": "tests/ffi/import_function.exp", "content": "Hello world\nMy pid didn't change\nDoing another foreign call\nHi mum\ndone\n" }, { "path": "tests/ffi/import_function.h", "content": "/*\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n#ifndef IMPORT_FONCTION_H\n#define IMPORT_FONCTION_H\n\nunsigned foo(void * stack_, unsigned sp);\nunsigned my_getpid(void * stack_, unsigned sp);\n\n#endif /* ! IMPORT_FONCTION_H */\n\n" }, { "path": "tests/ffi/import_function.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ImportFunction\n\npragma foreign_include(\"import_function.h\")\n\nfunc getpid() -> Int\n foreign(my_getpid)\n\nfunc foo() uses IO\n foreign(foo)\n\nentrypoint\nfunc hello() uses IO -> Int {\n print!(\"Hello world\\n\")\n\n var pid = getpid!()\n print!(\"# My pid is \" ++ int_to_string(pid) ++ \"\\n\")\n\n var pid2 = getpid!()\n if (pid == pid2) {\n print!(\"My pid didn't change\\n\")\n } else {\n print!(\"My pid changed, that's weird\\n\")\n }\n\n print!(\"Doing another foreign call\\n\")\n foo!()\n print!(\"done\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/ffi/import_shared_module.cpp", "content": "/*\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n#include \n\n#include \"../../runtime/pz_common.h\"\n#include \"../../runtime/pz_foreign.h\"\n#include \"../../runtime/pz_generic_run.h\"\n\n#include \"import_shared_module.h\"\n\nusing namespace pz;\n\nunsigned test_extra(void * stack_, unsigned sp)\n{\n printf(\"Test Extra\\n\");\n return sp;\n}\n\n" }, { "path": "tests/ffi/import_shared_module.h", "content": "/*\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n#ifndef IMPORT_SHARED_MODULE_H\n#define IMPORT_SHARED_MODULE_H\n\nunsigned test_extra(void * stack_, unsigned sp);\n\n#endif /* ! IMPORT_SHARED_MODULE_H */\n\n" }, { "path": "tests/ffi/import_shared_module.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ImportSharedModule \n\npragma foreign_include(\"import_shared_module.h\")\n\nfunc test_extra()\n foreign(test_extra)\n\nentrypoint\nfunc test() uses IO -> Int {\n test_extra!()\n\n return 0\n}\n\n" }, { "path": "tests/ffi/import_two_sources.cpp", "content": "/*\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n#include \n\n#include \"../../runtime/pz_common.h\"\n#include \"../../runtime/pz_foreign.h\"\n#include \"../../runtime/pz_generic_run.h\"\n\n#include \"import_two_sources.h\"\n\nusing namespace pz;\n\nunsigned test_a(void * stack_, unsigned sp)\n{\n printf(\"Test A\\n\");\n return sp;\n}\n\n" }, { "path": "tests/ffi/import_two_sources.exp", "content": "Test A\nTest Extra\n" }, { "path": "tests/ffi/import_two_sources.h", "content": "/*\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n#ifndef IMPORT_TWO_SOURCES_H\n#define IMPORT_TWO_SOURCES_H\n\nunsigned test_a(void * stack_, unsigned sp);\n\n#endif /* ! IMPORT_TWO_SOURCES */\n\n" }, { "path": "tests/ffi/import_two_sources.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ImportTwoSources \n\npragma foreign_include(\"import_two_sources.h\")\npragma foreign_include(\"import_shared_module.h\")\n\nfunc test_a()\n foreign(test_a)\nfunc test_extra()\n foreign(test_extra)\n\nentrypoint\nfunc test() uses IO -> Int {\n test_a!()\n test_extra!()\n\n return 0\n}\n\n" }, { "path": "tests/ffi/unrecognised_extension.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure\n\n[unrecognised_extension]\ntype = program\nmodules = [UnrecognisedExtension]\nc_sources = [bad.extension]\n\n" }, { "path": "tests/ffi/unrecognised_extension.exp", "content": "unrecognised_extension.build:9: Unrecognised extensions on these files:\n bad.extension\n" }, { "path": "tests/ffi/unrecognised_extension.p", "content": "" }, { "path": "tests/hello.exp", "content": "Hello world\n" }, { "path": "tests/hello.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n// Module declaration, this sets the name of the module.\nmodule Hello\n\n// The main function, there's multiple things in the signature:\n// * It has zero parameters but in the future it will probably take an\n// argument for command line options.\n// * It returns Int.\n// * It uses the IO resource.\n// * It has the 'entrypoint' keyword\n\nentrypoint\nfunc main() uses IO -> Int {\n // the ! indicates that this call uses a resource, which resource is\n // determined automatically.\n print!(\"Hello world\\n\")\n\n // 0 is the operating system's exit code for success. This should be\n // symbolic in the future.\n return 0\n}\n\n" }, { "path": "tests/language/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[arity_01]\ntype = program\nmodules = [Arity01]\n\n[comment]\ntype = program\nmodules = [Comment]\n\n[ite_1]\ntype = program\nmodules = [Ite_1]\n\n[ite_2]\ntype = program\nmodules = [Ite_2]\n\n[ite_3]\ntype = program\nmodules = [Ite_3]\n\n[list]\ntype = program\nmodules = [List]\n\n[operators]\ntype = program\nmodules = [Operators]\n\n[string]\ntype = program\nmodules = [String]\n\n" }, { "path": "tests/language/arity_01.exp", "content": "8\np: 7, m: -7\np: 23, m: -23\nTest foo2\nTest foo3\nfoo4\npm(8) -> 8, -8\nTest5 : 285, -285\n" }, { "path": "tests/language/arity_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Arity01\n\nentrypoint\nfunc main() uses IO -> Int {\n foo!(int_to_string(bar(3, 5)) ++ \"\\n\")\n\n do_pm!(7)\n do_pm!(-23)\n\n var x = 3 // Check that the stack is still aligned.\n foo2!(\"Test foo2\\n\")\n foo3!(\"Test foo3\\n\")\n noop!()\n\n foo4!(4)\n\n // Multi-arity in higher-order code.\n var n = 8\n var f = fst(pm, n)\n var s = snd(pm, n)\n\n print!(\"pm(\" ++ int_to_string(n) ++ \") -> \" ++\n int_to_string(f) ++ \", \" ++ int_to_string(s) ++ \"\\n\")\n\n var f5a, var f5b = foo5()\n print!(\"Test5 : \" ++ int_to_string(f5a) ++ \", \" ++ int_to_string(f5b) ++\n \"\\n\")\n\n return x - 3 + f + s\n}\n\n// Test a function that returns nothing.\nfunc foo(x : String) uses IO {\n print!(x)\n}\n\n// This function returns numthing, but ends in an assignment, which is stupid\n// but for now legal. It should generate a warning in the future.\nfunc foo2(x : String) uses IO {\n print!(x)\n var y = x\n}\n\n// Test a function that returns nothing, and has an empty return statement.\nfunc foo3(x : String) uses IO {\n print!(x)\n return\n}\n\nfunc noop() uses IO {}\n\n// A function that returns one thing.\nfunc bar(a : Int, b : Int) -> Int {\n return a + b\n}\n\nfunc do_pm(x : Int) uses IO {\n var p, var m = pm(x)\n print!(\"p: \" ++ int_to_string(p) ++ \", m: \" ++ int_to_string(m) ++ \"\\n\")\n}\n\nfunc fst(f : func(Int) -> (Int, Int), input : Int) -> Int {\n var a, _ = f(input)\n return a\n}\n\nfunc snd(f : func(Int) -> (Int, Int), input : Int) -> Int {\n _, var b = f(input)\n return b\n}\n\n// A function that returns two things.\nfunc pm(x : Int) -> (Int, Int) {\n var x_abs\n if (x < 0) {\n x_abs = x * -1\n } else {\n x_abs = x\n }\n return x_abs, x_abs * -1\n}\n\n// Something that returns something may have its result thrown away.\n// Although this specific example should be a warning since the call to bar\n// also has no affects, it would be optimised away.\nfunc foo4(x : Int) uses IO {\n print!(\"foo4\\n\")\n _ = bar(x, 23)\n}\n\nfunc foo5() -> (Int, Int) {\n // Bug 285\n return pm(285)\n}\n\n" }, { "path": "tests/language/arity_02.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[arity_02]\ntype = program\nmodules = [Arity02]\n\n" }, { "path": "tests/language/arity_02.exp", "content": "arity_02.p:12: Arity error got 2 values, but 1 values were expected\narity_02.p:13: Arity error got 1 values, but 0 values were expected\narity_02.p:19: Arity error got 0 values, but 1 values were expected\narity_02.p:23: Arity error got 1 values, but 0 values were expected\narity_02.p:28: Arity error got 1 values, but 0 values were expected\narity_02.p:32: Arity error got 1 values, but 0 values were expected\narity_02.p:38: Arity error got 0 values, but 1 values were expected\narity_02.p:42: Arity error got 0 values, but 1 values were expected\n" }, { "path": "tests/language/arity_02.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Arity02\n\nexport\nfunc main() uses IO -> Int {\n // Arity mismatch in call\n print!(hello())\n bar!()\n return 0\n}\n\nfunc bar() uses IO -> Int {\n // Arity mismatch in return.\n return\n}\n\nfunc bar2() uses IO {\n return 3\n}\n\nfunc test1() uses IO {\n // It is an error not to capture the returned values when there are some.\n cube(3)\n}\n\nfunc test2() uses IO {\n cube(2)\n return\n}\n\nfunc test3() uses IO {\n // There are no returned values here, this is an arity mismatch.\n _ = print!(\"Boo\\n\")\n}\n\nfunc test4() uses IO {\n _ = print!(\"Boo\\n\")\n return\n}\n\n\n\nfunc cube(n : Int) -> Int { return n * n * n }\n\nfunc hello() -> (String, Int) {\n return \"Hi\", 3\n}\n\n" }, { "path": "tests/language/arity_ho_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[arity_ho_1]\ntype = program\nmodules = [Arity_HO_1]\n\n" }, { "path": "tests/language/arity_ho_1.exp", "content": "arity_ho_1.p:12: \"func(int) -> int\" and \"func(int) -> (int, int)\" are not the\n same\n" }, { "path": "tests/language/arity_ho_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Arity_HO_1\n\nexport\nfunc main() uses IO -> Int {\n // Incorrect arity (type) in function passed to higher order function.\n var f = fst(add4, 3)\n \n return 0\n}\n\nfunc fst(f : func(Int) -> (Int, Int), input : Int) -> Int {\n var a, _ = f(input)\n return a\n}\n\nfunc add4(n : Int) -> Int {\n return n + 4\n}\n\n" }, { "path": "tests/language/arity_ho_2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[arity_ho_2]\ntype = program\nmodules = [Arity_HO_2]\n\n" }, { "path": "tests/language/arity_ho_2.exp", "content": "arity_ho_2.p:16: \"func(int) -> int\" and \"func(int) -> (int, int)\" are not the\n same\n" }, { "path": "tests/language/arity_ho_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Arity_HO_2\n\nexport\nfunc main() uses IO -> Int {\n var f = fst(pm, 3)\n \n return 0\n}\n\nfunc fst(f : func(Int) -> (Int, Int), input : Int) -> Int {\n // Incorrect arity in call to higher-order function.\n var a = f(input)\n return a\n}\n\n// A function that returns two things.\nfunc pm(x : Int) -> (Int, Int) {\n var x_abs\n if (x < 0) {\n x_abs = x * -1\n } else {\n x_abs = x\n }\n return x_abs, x_abs * -1\n}\n\n" }, { "path": "tests/language/arity_lambda.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[arity_lambda]\ntype = program\nmodules = [ArityLambda]\n\n" }, { "path": "tests/language/arity_lambda.exp", "content": "arity_lambda.p:11: Function returns 1 results but this path has no return\n statement\n" }, { "path": "tests/language/arity_lambda.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ArityLambda\n\nexport\nfunc main() uses IO -> Int {\n func test() -> Int {\n // Error, there's no return statment\n }\n\n return 0\n}\n\n" }, { "path": "tests/language/comment.exp", "content": "1e2e3e4e5e6e7e8e\n // comment in a string, not realy a comment.\n /* comment in a string, not realy a comment.\n */ comment in a string, not realy a comment.\n" }, { "path": "tests/language/comment.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Comment\n\nentrypoint\nfunc main() uses IO -> Int {\n // We support coments like this.\n /* and like this */\n\n var str = \"\" ++ // this comments out the rest of the line\n \"1\" ++ /* this commented out */ \"e\" ++ // but the line continued\n \"2\" ++ /**/ \"e\" ++\n \"3\" ++ /* * */ \"e\" ++\n \"4\" ++ /* ** */ \"e\" ++\n \"5\" ++ /* *** */ \"e\" ++\n \"6\" ++ /*** */ \"e\" ++\n \"7\" ++ /* // aq */ \"e\" ++\n \"8\" ++ // /*<- not the beginning of a comment.\n \"e\" ++\n \"\"\n /*\n * Note that we don't support a * next to the ending star-slash due to\n * limitations in the regex library.\n */\n\n print!(str ++ \"\\n\")\n\n print!(\" // comment in a string, not realy a comment.\\n\")\n print!(\" /* comment in a string, not realy a comment.\\n\")\n print!(\" */ comment in a string, not realy a comment.\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/language/comment_end.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n# PLZTEST todo commend end lexing\n\n[comment_end]\ntype = program\nmodules = [CommentEnd]\n" }, { "path": "tests/language/comment_end.exp", "content": "comment_end.p:18: The tokeniser got confused, until we improve it please don't\n end comments with **/\ncomment_end.p:19: Warning: The tokeniser can get confused, until we improve it\n please don't end comments with **/\n" }, { "path": "tests/language/comment_end.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule CommentEnd\n\nexport\nfunc main() uses IO -> Int {\n print!(\"Hello world\\n\")\n\n // This will match the second */ and so we must throw an error if there's a\n // */ within a coment.\n\n // It's an odd number of *'s in the middle to trigger the test, but try\n // with an even number too and we'll know if the test changes.\n /*****/ /* */\n /****/ /* */\n\n return 0\n}\n\n" }, { "path": "tests/language/coverage_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[coverage_1]\ntype = program\nmodules = [Coverage_1]\n\n" }, { "path": "tests/language/coverage_1.exp", "content": "coverage_1.p:19: Match does not cover all cases\ncoverage_1.p:28: Match does not cover all cases\ncoverage_1.p:41: This case will never be tested because earlier cases cover all\n values\ncoverage_1.p:53: This case will never be tested because earlier cases cover all\n values\ncoverage_1.p:64: This case occurs multiple times in this match\ncoverage_1.p:76: This case occurs multiple times in this match\n" }, { "path": "tests/language/coverage_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Coverage_1\n\ntype Suit = Hearts | Diamonds | Spades | Clubs\n\nfunc main() uses IO -> Int {\n print!(\"Queen of \" ++ suit_str(Hearts) ++ \"\\n\")\n print!(\"Ace of \" ++ suit_str(Spades) ++ \"\\n\")\n return 0\n}\n\nfunc suit_str(s : Suit) -> String {\n // Uncovered data tag.\n match (s) {\n Hearts -> { return \"Hearts\" }\n Diamonds -> { return \"Diamonds\" }\n Clubs -> { return \"Clubs\" }\n }\n}\n\nfunc num_word(n : Int) -> String {\n // Uncovered data.\n match (n) {\n 0 -> { return \"zero\" }\n 1 -> { return \"one\" }\n }\n}\n\nfunc num_word2(n : Int) -> String {\n match (n) {\n 0 -> { return \"zero\" }\n 1 -> { return \"one\" }\n _ -> { return \"many\" }\n\n // This case is never tested.\n 5 -> { return \"five\" }\n }\n}\n\nfunc suit_str2(s : Suit) -> String {\n match (s) {\n Hearts -> { return \"Hearts\" }\n Diamonds -> { return \"Diamonds\" }\n Clubs -> { return \"Clubs\" }\n Spades -> { return \"Spades\" }\n\n // This case is never tested.\n _ -> { return \"Unknown\" }\n }\n}\n\nfunc suit_str3(s : Suit) -> String {\n // Uncovered data tag.\n match (s) {\n Hearts -> { return \"Hearts\" }\n Diamonds -> { return \"Diamonds\" }\n\n // This case always fails.\n Diamonds -> { return \"Girl's best friend\" }\n Clubs -> { return \"Clubs\" }\n Spades -> { return \"Spades\" }\n }\n}\n\nfunc num_word3(n : Int) -> String {\n match (n) {\n 0 -> { return \"zero\" }\n 1 -> { return \"one\" }\n\n // This case always fails.\n 1 -> { return \"onesies\" }\n\n _ -> { return \"many\" }\n }\n}\n" }, { "path": "tests/language/entrypoint_bad_sig.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[entrypoint_bad_sig]\ntype = program\nmodules = [EntrypointBadSig]\n\n" }, { "path": "tests/language/entrypoint_bad_sig.exp", "content": "entrypoint_bad_sig.p:15: A function that is marked as an entrypoint does not\n have the correct signature for an entrypoint.\n" }, { "path": "tests/language/entrypoint_bad_sig.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule EntrypointBadSig \n\n/*\n * This program has an entrypoint function, but it has an incorrect\n * signature for an entrypoint.\n */\n\nentrypoint\nfunc main(foo : String) uses IO -> Int {\n // the ! indicates that this call uses a resource, which resource is\n // determined automatically where possible.\n print!(\"Hello world\\n\")\n\n // The value of a function (or block) is the value of its last\n // statement.\n // XXX EXIT_SUCCESS\n return 0\n}\n\n" }, { "path": "tests/language/entrypoint_multi.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[entrypoint_multi]\ntype = program\nmodules = [EntrypointMulti]\n\n" }, { "path": "tests/language/entrypoint_multi.exp", "content": "Error: No unique entrypoint found, found 2 entrypoints\n" }, { "path": "tests/language/entrypoint_multi.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule EntrypointMulti \n\nentrypoint\nfunc name1() uses IO -> Int {\n print!(\"Hello world 1\\n\") \n return 0\n}\n\nentrypoint\nfunc name2() uses IO -> Int {\n print!(\"Hello world 2\\n\") \n return 0\n}\n\n" }, { "path": "tests/language/entrypoint_none.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[entrypoint_none]\ntype = program\nmodules = [EntrypointNone]\n\n" }, { "path": "tests/language/entrypoint_none.exp", "content": "Error: No unique entrypoint found, found 0 entrypoints\n" }, { "path": "tests/language/entrypoint_none.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule EntrypointNone \n\n// This is exported but not marked as an entrypoint, the linker will be\n// unable to find an entrypoint in the program.\nexport\nfunc main() uses IO -> Int {\n // the ! indicates that this call uses a resource, which resource is\n // determined automatically where possible.\n print!(\"Hello world\\n\")\n\n // The value of a function (or block) is the value of its last\n // statement.\n // XXX EXIT_SUCCESS\n return 0\n}\n\n" }, { "path": "tests/language/export_bad_resource.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[export_bad_resource]\ntype = program\nmodules = [ExportBadResource]\n\n" }, { "path": "tests/language/export_bad_resource.exp", "content": "export_bad_resource.p:19: The resource Bar is exported, but it depends on Foo\n which is not\nexport_bad_resource.p:23: The resource Bar2 is exported, but it depends on Foo\n which is not\nexport_bad_resource.p:66: The type Type1 is exported, but it refers to the\n resource Baz which is not exported\nexport_bad_resource.p:72: The type Type2 is exported, but it refers to the\n resource Baz which is not exported\nexport_bad_resource.p:72: The type Type2 is exported, but it refers to the\n resource Baz2 which is not exported\nexport_bad_resource.p:35: The function troz is exported, but it refers to the\n resource Foo which is not exported\nexport_bad_resource.p:40: The function zort is exported, but it refers to the\n resource Baz which is not exported\nexport_bad_resource.p:49: The function silly_sound is exported, but it refers\n to the resource Baz which is not exported\nexport_bad_resource.p:54: The function silly_sound2 is exported, but it refers\n to the resource Baz which is not exported\nexport_bad_resource.p:54: The function silly_sound2 is exported, but it refers\n to the resource Baz2 which is not exported\nexport_bad_resource.p:59: The function silly_sound3 is exported, but it refers\n to the resource Baz which is not exported\n" }, { "path": "tests/language/export_bad_resource.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ExportBadResource\n\nresource Foo from IO\n\n/*\n * The error will be reported on the exported item that need a non-exported\n * resource. It should (but doesn't) refer to the line of the non-exported\n * resource. A non-exported thing can be reported more than once.\n */\n\n// Error Foo is not exported and Bar expects this.\nexport\nresource Bar from Foo\n\n// also an error.\nexport\nresource Bar2 from Foo\n\n// Not an error\nexport\nresource BarBar from Bar\n\n// No error.\nresource Baz from Foo\nresource Baz2 from Foo\n\n// Error Foo is not exported\nexport\nfunc troz() uses Foo {\n}\n\n// Error Baz is not exported\nexport\nfunc zort() uses Baz {\n}\n\n// No error.\nfunc zort2() uses Baz {\n}\n\n// This time the error is in a type used by a function.\nexport\nfunc silly_sound(x : func(Int) uses Baz) {\n}\n\n// Should have two errors, for Baz and Baz2\nexport\nfunc silly_sound2(x : func(Int) uses (Bar, Baz, Baz2)) {\n}\n\n// Should have only one error (same resource twice)\nexport\nfunc silly_sound3(x : func(Int) uses (Baz, Bar), y : func(String) uses Baz)\n uses Baz\n{\n}\n\n// Error\nexport\ntype Type1 = Type1(\n a : func(Int) uses Baz\n)\n\n// Multiple errors.\nexport\ntype Type2 = Type2(\n b : func(Int) uses (Baz, Bar),\n c : List(func(Int) uses Baz2)\n)\n\n// No errors.\ntype Type3 = Type3(\n d : func(Int) uses (Baz, Bar),\n e : List(func(Int) uses Baz2)\n)\n\n// No errors.\nexport opaque \ntype Type4 = Type4(\n f : func(Int) uses (Baz, Bar),\n g : List(func(Int) uses Baz2)\n)\n\n" }, { "path": "tests/language/export_bad_type.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[export_bad_type]\ntype = program\nmodules = [ExportBadType]\n\n" }, { "path": "tests/language/export_bad_type.exp", "content": "export_bad_type.p:20: The type T1 is exported, but it refers to another type T0\n which is not.\nexport_bad_type.p:26: The type T2 is exported, but it refers to another type T0\n which is not.\nexport_bad_type.p:62: The function fun1 is exported, but it refers to the type\n T0 which is not.\nexport_bad_type.p:67: The function fun2 is exported, but it refers to the type\n T0 which is not.\n" }, { "path": "tests/language/export_bad_type.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ExportBadType\n\ntype T0 = T0 ( \n f1 : Int\n)\n\nexport opaque\ntype T0a = T0a (\n f1a : Int\n)\n\n// Error, T0 is not exported.\nexport\ntype T1 = T1 (\n f2 : T0\n)\n\n// Error, T0 is not exported.\nexport\ntype T2 = T2 (\n f3 : List(T0)\n)\n\n// No error, because T3 isn't exported\ntype T3 = T3 (\n f4 : T0,\n f5 : List(T0)\n)\n\n// No error, because the type we refer to is exported abstractly.\nexport\ntype T1ia = T1ia (\n f2ia : T0a\n)\n\n// No error\nexport\ntype T2ia = T2ia (\n f3ia : List(T0a)\n)\n\n// No error, because importing libraries don't need to know what this refers\n// to.\nexport opaque\ntype T1a = T1a (\n f2a : T0\n)\n\nexport opaque\ntype T2a = T2a (\n f2a : List(T0)\n)\n\n// Error\nexport\nfunc fun1(a : T0) uses IO {\n}\n\n// Error\nexport\nfunc fun2(a : List(T0)) uses IO { \n}\n\n// No-error\nfunc fun3(a : T0, b : List(T0)) uses IO {\n}\n\n// No-error\nfunc fun4(a : T0a, b : List(T0a)) uses IO {\n}\n\n" }, { "path": "tests/language/ho/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[closure_01]\ntype = program\nmodules = [Closure_01]\n\n[closure_02]\ntype = program\nmodules = [Closure_02]\n\n[closure_03]\ntype = program\nmodules = [Closure_03]\n\n[closure_04]\ntype = program\nmodules = [Closure_04]\n\n[closure_05]\ntype = program\nmodules = [Closure_05]\n\n[closure_06]\ntype = program\nmodules = [Closure_06]\n\n[ho_1]\ntype = program\nmodules = [HO_1]\n\n[ho_2]\ntype = program\nmodules = [HO_2]\n\n[ho_call_bug_30]\ntype = program\nmodules = [HOCallBug30]\n\n" }, { "path": "tests/language/ho/closure_01.exp", "content": "Hello Paul\n" }, { "path": "tests/language/ho/closure_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_01\n\nentrypoint\nfunc main() uses IO -> Int {\n var greeting = \"Hello \"\n func hi(name : String) -> String {\n return greeting ++ name ++ \"\\n\"\n }\n\n print!(hi(\"Paul\"))\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_02.exp", "content": "Hello Paul\n" }, { "path": "tests/language/ho/closure_02.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_02\n\nentrypoint\nfunc main() uses IO -> Int {\n var greeting = \"Hello \"\n\n func hi(name : String) -> String {\n var msg = greeting ++ name ++ \"\\n\"\n return msg\n }\n\n // We should be able to use this variable here, the above one isn't in\n // scope.\n var msg = hi(\"Paul\")\n print!(msg)\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_03.exp", "content": "G'day Paul\nG'day James\n" }, { "path": "tests/language/ho/closure_03.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_03\n\nentrypoint\nfunc main() uses IO -> Int {\n var salutation = \"G'day\"\n\n func greet(name : String) uses IO {\n print!(salutation ++ \" \" ++ name)\n // Try to trick the compiler with two bang statements inside the one\n // closure which is itself a single statement.\n print!(\"\\n\")\n }\n\n greet!(\"Paul\")\n greet!(\"James\")\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_04.exp", "content": "7 bottles of wine...\n6 bottles of wine...\n5 bottles of wine...\n4 bottles of wine...\n3 bottles of wine...\n2 bottles of wine...\n1 bottles of wine...\nNo more wine\n" }, { "path": "tests/language/ho/closure_04.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_04\n\nfunc make_closure(drink : String) -> func() uses IO {\n func sing(n : Int) -> String {\n if (n == 0) {\n return \"No more \" ++ drink ++ \"\\n\"\n } else {\n return int_to_string(n) ++ \" bottles of \" ++ drink ++ \"...\\n\" ++\n sing(n - 1)\n }\n }\n\n func doit() uses IO {\n print!(sing(7))\n }\n\n return doit\n}\n\nentrypoint\nfunc main() uses IO -> Int {\n var my_closure = make_closure(\"wine\")\n\n my_closure!()\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_05.exp", "content": "4 bottles of wine...\n3 bottles of wine...\n2 bottles of wine...\n1 bottles of wine...\nNo more wine\n" }, { "path": "tests/language/ho/closure_05.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_05\n\n// Wrap this in a function to help the typechecker.\nfunc lines() -> Int {\n return 4\n}\n\nentrypoint\nfunc main() uses IO -> Int {\n\n func phrase1(drink : String) -> String {\n return \"No more \" ++ drink ++ \"\\n\"\n }\n func make_closure(drink : String) -> func() uses IO {\n func sing(n : Int) -> String {\n if (n == 0) {\n return phrase1(drink)\n } else {\n return int_to_string(n) ++ \" bottles of \" ++ drink ++ \"...\\n\" ++\n sing(n - 1)\n }\n }\n\n func doit() uses IO {\n print!(sing(lines()))\n }\n\n return doit\n }\n\n var my_closure = make_closure(\"wine\")\n\n my_closure!()\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_06.exp", "content": "4 bottles of wine...\n3 bottles of wine...\n2 bottles of wine...\n1 bottles of wine...\nNo more wine\n" }, { "path": "tests/language/ho/closure_06.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_06\n\nfunc phrase1(drink : String) -> String {\n return \"No more \" ++ drink ++ \"\\n\"\n}\n\nfunc make_closure(drink : String) -> func(Int) uses IO {\n func sing(n : Int) uses IO {\n if (n == 0) {\n // The compiler will generate a call that does not set the\n // environment.\n print!(phrase1(drink))\n } else {\n print!(int_to_string(n) ++ \" bottles of \" ++ drink ++\n \"...\\n\")\n sing!(n - 1)\n }\n }\n\n return sing \n}\n\nentrypoint\nfunc main() uses IO -> Int {\n\n var my_closure = make_closure(\"wine\")\n\n my_closure!(4)\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_01.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_01]\ntype = program\nmodules = [Closure_Bad_01]\n\n" }, { "path": "tests/language/ho/closure_bad_01.exp", "content": "closure_bad_01.p:15: Arity error got 1 values, but 0 values were expected\n" }, { "path": "tests/language/ho/closure_bad_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_01\n\nexport\nfunc main() uses IO -> Int {\n var greeting = \"Hello \"\n\n // The compiler crashs when we forget the return type for the closure.\n func hi(name : String) {\n return greeting ++ name ++ \"\\n\"\n }\n\n print!(hi(\"Paul\"))\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_02.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_02]\ntype = program\nmodules = [Closure_Bad_02]\n\n" }, { "path": "tests/language/ho/closure_bad_02.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown symbol: msg\nContext: ../closure_bad_02.p:22\nplzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/ho/closure_bad_02.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_02\n\nexport\nfunc main() uses IO -> Int {\n var greeting = \"Hello \"\n\n // The compiler crashs when we forget the return type for the closure.\n func hi(name : String) -> String {\n var msg = greeting ++ name ++ \"\\n\"\n return msg\n }\n\n print!(hi(\"Paul\"))\n\n // msg wont be available here\n print!(msg)\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_03.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_03]\ntype = program\nmodules = [Closure_Bad_03]\n\n" }, { "path": "tests/language/ho/closure_bad_03.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: The variable 'msg' is already declared\nContext: ../closure_bad_03.p:17\nplzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/ho/closure_bad_03.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_03\n\nexport\nfunc main() uses IO -> Int {\n var greeting = \"Hello \"\n\n var msg\n\n // The compiler crashs when we forget the return type for the closure.\n func hi(name : String) -> String {\n var msg = greeting ++ name ++ \"\\n\"\n return msg\n }\n\n print!(hi(\"Paul\"))\n\n // msg wont be available here\n print!(msg)\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_04.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_04]\ntype = program\nmodules = [Closure_Bad_04]\n\n" }, { "path": "tests/language/ho/closure_bad_04.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: The variable 'msg' is already declared\nContext: ../closure_bad_04.p:17\nplzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/ho/closure_bad_04.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_04\n\nexport\nfunc main() uses IO -> Int {\n var greeting = \"Hello \"\n\n var msg = \"quack!\"\n\n // The compiler crashs when we forget the return type for the closure.\n func hi(name : String) -> String {\n var msg = greeting ++ name ++ \"\\n\"\n return msg\n }\n\n print!(hi(\"Paul\"))\n\n // msg wont be available here\n print!(msg)\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_05.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_05]\ntype = program\nmodules = [Closure_Bad_05]\n\n" }, { "path": "tests/language/ho/closure_bad_05.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown variable or constructor 'msg'\nContext: ../closure_bad_05.p:15\nplzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/ho/closure_bad_05.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_05\n\nexport\nfunc main() uses IO -> Int {\n var greeting = \"Hello \"\n\n // The compiler crashs when we forget the return type for the closure.\n func hi(name : String) -> String {\n msg = greeting ++ name ++ \"\\n\"\n return msg\n }\n\n print!(hi(\"Paul\"))\n\n // msg wont be available here\n print!(msg)\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_06.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_06]\ntype = program\nmodules = [Closure_Bad_06]\n\n" }, { "path": "tests/language/ho/closure_bad_06.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: The variable 'msg' is defined in an outer scope and cannot be initialised from within this closure\nContext: ../closure_bad_06.p:17\nplzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/ho/closure_bad_06.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_06\n\nexport\nfunc main() uses IO -> Int {\n var greeting = \"Hello \"\n\n var msg\n\n // The compiler crashs when we forget the return type for the closure.\n func hi(name : String) -> String {\n msg = greeting ++ name ++ \"\\n\"\n return msg\n }\n\n print!(hi(\"Paul\"))\n\n // msg wont be available here\n print!(msg)\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_07.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_07]\ntype = program\nmodules = [Closure_Bad_07]\n\n" }, { "path": "tests/language/ho/closure_bad_07.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: The variable 'msg' is already initialised\nContext: ../closure_bad_07.p:17\nplzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/ho/closure_bad_07.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_07\n\nexport\nfunc main() uses IO -> Int {\n var greeting = \"Hello \"\n\n var msg = \"quack!\"\n\n // The compiler crashs when we forget the return type for the closure.\n func hi(name : String) -> String {\n msg= greeting ++ name ++ \"\\n\"\n return msg\n }\n\n print!(hi(\"Paul\"))\n\n // msg wont be available here\n print!(msg)\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_08.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_08]\ntype = program\nmodules = [Closure_Bad_08]\n\n" }, { "path": "tests/language/ho/closure_bad_08.exp", "content": "closure_bad_08.p:17: Call uses or observes a resource but has no !\n" }, { "path": "tests/language/ho/closure_bad_08.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_08\n\nexport\nfunc main() uses IO -> Int {\n var salutation = \"G'day\"\n\n func greet(name : String) uses IO {\n print!(salutation ++ \" \" ++ name ++ \"\\n\")\n }\n\n greet(\"Paul\")\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_09.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_09]\ntype = program\nmodules = [Closure_Bad_09]\n\n" }, { "path": "tests/language/ho/closure_bad_09.exp", "content": "closure_bad_09.p:14: Call uses or observes a resource but has no !\n" }, { "path": "tests/language/ho/closure_bad_09.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_09\n\nexport\nfunc main() uses IO -> Int {\n var salutation = \"G'day\"\n\n func greet(name : String) uses IO {\n print(salutation ++ \" \" ++ name ++ \"\\n\")\n }\n\n greet!(\"Paul\")\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_bad_10.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[closure_bad_10]\ntype = program\nmodules = [Closure_Bad_10]\n\n" }, { "path": "tests/language/ho/closure_bad_10.exp", "content": "closure_bad_10.p:14: One or more resources needed for this call is unavailable\n in this function\n" }, { "path": "tests/language/ho/closure_bad_10.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Closure_Bad_10\n\nexport\nfunc main() uses IO -> Int {\n var salutation = \"G'day\"\n\n func greet(name : String) -> Int {\n print!(salutation ++ \" \" ++ name ++ \"\\n\")\n return 3\n }\n\n _ = greet(\"Paul\")\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/closure_mut_rec.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST todo Closure mutual recursion\n# PLZTEST type compile_failure \n\n[closure_mut_rec]\ntype = program\nmodules = [ClosureMutRec]\n" }, { "path": "tests/language/ho/closure_mut_rec.exp", "content": "A feature required by your program is currently unimplemented,\nhowever this is something we hope to implement in the future. Sorry\n\nFeature: is_even is possibly involved in a mutual recursion of closures. If they're not mutually recursive try re-ordering them.\nContext: ../closure_mut_rec.p:14\nLocation: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nFile: pre.from_ast.m\n" }, { "path": "tests/language/ho/closure_mut_rec.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ClosureMutRec \n\nfunc make_is_odd() -> func(Int) -> Bool {\n func is_odd(n : Int) -> Bool {\n if (n == 0) {\n return False\n } else {\n return is_even(n-1)\n }\n }\n func is_even(n : Int) -> Bool {\n if (n == 0) {\n return True\n } else {\n return is_odd(n-1)\n }\n }\n\n return is_odd\n}\n\nexport\nfunc main() uses IO -> Int {\n func odd_or_even(n : Int) -> String {\n var is_odd = make_is_odd()\n if (is_odd(n)) {\n return \"odd\"\n } else {\n return \"even\"\n }\n }\n\n var n = 23\n print!(int_to_string(n) ++ \" is \" ++ odd_or_even(n))\n\n return 0\n}\n\n" }, { "path": "tests/language/ho/ho_1.exp", "content": "Hello Paul\nHello Paul again\n55\n13, 24, 1728\nMy favorite colours is Blue\nMy favorite season is Winter\nMy favorite season is Snow time\n" }, { "path": "tests/language/ho/ho_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HO_1 \n\n// TODO:\n// Need to implement and test HO values in type arguments\n\nfunc f1(a : Int) -> Int { return a + 1 }\nfunc f2(a : Int) -> Int { return a * 2 }\nfunc f3(a : Int) -> Int { return pow(a, 3) }\n\nentrypoint\nfunc main() uses IO -> Int {\n // Basic HO use.\n var x = hello_msg\n print!(x(\"Paul\"))\n\n // Basic HO call\n print!(apply(hello_msg, \"Paul again\"))\n\n // Reduce a function over a list.\n print!(int_to_string(reduce(add, up_to(10), 0)) ++ \"\\n\")\n\n // Store functions in data.\n var l = map(apply_to_12, [f1, f2, f3])\n // TODO: make this more abstract to deomonstrate more higher order code.\n print!(join(\", \", map(int_to_string, l)) ++ \"\\n\")\n\n // Return functions from other functions.\n var f = get_func(Colour)\n print!(f(\"Blue\") ++ \"\\n\")\n // Function application syntax.\n print!(get_func(Season)(\"Winter\") ++ \"\\n\")\n // Function application syntax as a statement.\n var fav_season = get_func(Season)(\"Snow time\")\n print!(fav_season ++ \"\\n\")\n\n return 0\n}\n\nfunc hello_msg(name : String) -> String {\n return \"Hello \" ++ name ++ \"\\n\"\n}\n\nfunc apply(f : func('a) -> ('b), arg : 'a) -> 'b {\n return f(arg)\n}\n\nfunc reduce(f : func('x, 'a) -> ('a), l : List('x), a : 'a) -> 'a {\n match (l) {\n [] -> { return a }\n [var x | var xs] -> { return f(x, reduce(f, xs, a)) }\n }\n}\n\nfunc map(f : func('x) -> ('y), l : List('x)) -> List('y) {\n match (l) {\n [] -> { return [] }\n [var x | var xs] -> { return [f(x) | map(f, xs)] }\n }\n}\n\nfunc apply_to_12(f : func(Int) -> ('y)) -> 'y { return f(12) }\n\nfunc join(j : String, l0 : List(String)) -> String {\n match (l0) {\n [] -> { return \"\" }\n // TODO once supported, test a nested pattern match:\n // [var x] -> { return x }\n // [var x, var y | var l] -> { return x ++ j ++ join(j, [y | l]) }\n\n // for now:\n [var x | var l] -> {\n match (l) {\n [] -> { return x }\n [_ | _] -> { return x ++ j ++ join(j, l) }\n }\n }\n }\n}\n\n/*-----*/\n\nfunc add(a : Int, b : Int) -> Int {\n return a + b\n}\n\nfunc pow(a : Int, b : Int) -> Int\n{\n match b {\n 0 -> { return 1 }\n 1 -> { return a }\n var n -> { return a * pow(a, n-1) }\n }\n}\n\nfunc up_to(a : Int) -> List(Int) {\n if (a == 0) {\n return []\n } else {\n return [a | up_to(a - 1)]\n }\n}\n\n/*-----*/\n\n// TODO: This example would be more idiomatic if we supported currying or lambdas\n\ntype FavouriteThing = Colour\n | Season\n\nfunc favourite_colour(c : String) -> String {\n return \"My favorite colours is \" ++ c\n}\nfunc favourite_season(s : String) -> String {\n return \"My favorite season is \" ++ s\n}\n\nfunc get_func(thing : FavouriteThing) -> func(String) -> String {\n match(thing) {\n Colour -> { return favourite_colour }\n Season -> { return favourite_season }\n }\n}\n\n" }, { "path": "tests/language/ho/ho_2.exp", "content": "1, 2, 3, \nHi\nMy favorite colour is Blue\n" }, { "path": "tests/language/ho/ho_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HO_2\n\n// Test higher-order code that uses resources\n// TODO: Polymorphic resource use.\n\nentrypoint\nfunc main() uses IO -> Int {\n // Ho code with a resource.\n do_for!(print_one, [1, 2, 3])\n print!(\"\\n\")\n\n // Put a higher order thing in a structure, then use it.\n var x = MyType(print)\n do!(x, \"Hi\\n\")\n\n // Return a resource using function from a function and call it.\n var f = get_func(Colour)\n f!(\"Blue\")\n\n return 0\n}\n\n/*-----*/\n\nfunc print_one(n : Int) uses IO {\n print!(int_to_string(n) ++ \", \")\n}\n\nfunc do_for(f : func('x) uses IO, l : List('x)) uses IO {\n match (l) {\n [] -> {}\n [var x | var xs] -> {\n f!(x)\n do_for!(f, xs)\n }\n }\n}\n\n/*-----*/\n\ntype MyType('x) = MyType(x : 'x)\n\nfunc do(tf : MyType(func('x) uses IO), x : 'x) uses IO {\n MyType(var f) = tf\n f!(x)\n}\n\n/*-----*/\n\n// TODO: This example would be more idiomatic if we supported currying or lambdas\ntype FavouriteThing = Colour\n | Season\n\nfunc favourite_colour(c : String) uses IO {\n print!(\"My favorite colour is \" ++ c ++ \"\\n\")\n}\nfunc favourite_season(s : String) uses IO {\n print!(\"My favorite season is \" ++ s ++ \"\\n\")\n}\n\nfunc get_func(thing : FavouriteThing) -> func(String) uses IO {\n match(thing) {\n Colour -> { return favourite_colour }\n Season -> { return favourite_season }\n }\n}\n\n/*-----*/\n" }, { "path": "tests/language/ho/ho_bad_7.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[ho_bad_7]\ntype = program\nmodules = [HO_Bad_7]\n\n" }, { "path": "tests/language/ho/ho_bad_7.exp", "content": "ho_bad_7.p:12: One or more resources needed for an argument to a call is not\n provided in by the passed-in value\nho_bad_7.p:18: One or more resources needed for an argument to a call is not\n provided in by the passed-in value\nho_bad_7.p:30: One or more resources needed for this call is unavailable in\n this function\nho_bad_7.p:44: Call uses or observes a resource but has no !\nho_bad_7.p:55: Warning: Call has a ! but does not need it\nho_bad_7.p:78: Call uses or observes a resource but has no !\nho_bad_7.p:90: One or more resources needed for this call is unavailable in\n this function\nho_bad_7.p:111: The function returns a higher order value that uses or observes\n one or more resources, however the resources arn't declared in\n the function's return type\n" }, { "path": "tests/language/ho/ho_bad_7.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HO_Bad_7\n\nexport\nfunc main() uses IO -> Int {\n // print_one uses a resource that do_for will not make available.\n do_for2!(print_one, [1, 2, 3])\n print!(\"\\n\")\n\n // Put a higher order thing in a structure, then use it but without the\n // correct resource.\n var x = MyType(print)\n apply!(x, \"Hi\\n\")\n\n return 0\n}\n\n////////\n\nfunc test() {\n // Basic HO use.\n // These currently generate confusing error messages, but it's still\n // something we can test.\n var x = hello_msg\n x!(\"Paul\")\n}\n\nfunc hello_msg(name : String) uses IO {\n print!(\"Hello \" ++ name ++ \"\\n\")\n}\n\n////////\n\nfunc do_for1(f : func('x) uses IO, l : List('x)) uses IO {\n match (l) {\n [] -> {}\n [var x | var xs] -> {\n // Missing bang.\n f(x)\n do_for1!(f, xs)\n }\n }\n}\n\nfunc do_for2(f : func('x), l : List('x)) uses IO {\n match (l) {\n [] -> {}\n [var x | var xs] -> {\n // f doesn't use a resource.\n f!(x)\n do_for2!(f, xs)\n }\n }\n}\n\nfunc print_one(n : Int) uses IO {\n print!(int_to_string(n) ++ \", \")\n}\n\n////////\n\ntype MyType('x) = MyType(x : 'x)\n\nfunc apply(mt : MyType(func('x)), x : 'x) uses IO {\n match(mt) {\n MyType(var f) -> { f(x) }\n }\n}\n\nfunc apply2(mt : MyType(func('x) uses IO), x : 'x) uses IO {\n match(mt) {\n // Call to f should have a !.\n MyType(var f) -> { f(x) }\n }\n}\n\n//////\n\nresource A from IO\nresource B from IO\n\nfunc test_return() uses A {\n // Return a resource using function from a function and call it.\n var f = get_func(Colour)\n f!(\"Blue\")\n}\n\n// TODO: This example would be more idiomatic if we supported currying or lambdas\ntype FavouriteThing = Colour\n | Season\n\nfunc favourite_colour(c : String) uses B {\n // print!(\"My favorite colour is \" ++ c ++ \"\\n\")\n}\nfunc favourite_season(s : String) uses B {\n // print!(\"My favorite season is \" ++ s ++ \"\\n\")\n}\n\nfunc get_func(thing : FavouriteThing) -> func(String) uses B {\n match(thing) {\n Colour -> { return favourite_colour }\n Season -> { return favourite_season }\n }\n}\n\nfunc get_func_broke(thing : FavouriteThing) -> func(String) uses A {\n match(thing) {\n Colour -> { return favourite_colour }\n Season -> { return favourite_season }\n }\n}\n\n//////\n" }, { "path": "tests/language/ho/ho_call_bug_30.exp", "content": "1, 2, 3\n" }, { "path": "tests/language/ho/ho_call_bug_30.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HOCallBug30\n\n// TODO:\n// Need to implement and test HO values in type arguments\n\nentrypoint\nfunc main() uses IO -> Int {\n // Higher order calls to builtins used to crash.\n print!(join(\", \", map(int_to_string, [1, 2, 3])) ++ \"\\n\")\n\n return 0\n}\n\nfunc map(f : func('x) -> ('y), l : List('x)) -> List('y) {\n match (l) {\n [] -> { return [] }\n [var x | var xs] -> { return [f(x) | map(f, xs)] }\n }\n}\n\nfunc join(j : String, l0 : List(String)) -> String {\n match (l0) {\n [] -> { return \"\" }\n [var x | var l] -> {\n match (l) {\n [] -> { return x }\n [_ | _] -> { return x ++ j ++ join(j, l) }\n }\n }\n }\n}\n" }, { "path": "tests/language/ite_1.exp", "content": "fib(16) = 1597\n" }, { "path": "tests/language/ite_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Ite_1 \n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"fib(16) = \" ++ int_to_string(fib(16)) ++ \"\\n\")\n return 0\n}\n\nfunc fib(n : Int) -> Int {\n if (n < 2) {\n return 1\n } else {\n return fib(n-1) + fib(n-2)\n }\n}\n\n" }, { "path": "tests/language/ite_2.exp", "content": "fib(16) = 1597\n" }, { "path": "tests/language/ite_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Ite_2\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"fib(16) = \" ++ int_to_string(fib(16)) ++ \"\\n\")\n return 0\n}\n\nfunc fib(n : Int) -> Int {\n // Parens are optional\n if n == 0 {\n return 1\n } else if (n == 1) {\n return 1\n } else {\n return fib(n-1) + fib(n-2)\n }\n}\n\n" }, { "path": "tests/language/ite_3.exp", "content": "fib1(16) = 1597\nfib2(16) = 1597\nfib4(16) = 1597\n10 more beers left. \n5 more beers left. \nOnly one beer left. worry...\nNo more beer! PANIC!\nYou owe someone a beer! Better repay them!\n" }, { "path": "tests/language/ite_3.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Ite_3 \n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"fib1(16) = \" ++ int_to_string(fib1(16)) ++ \"\\n\")\n print!(\"fib2(16) = \" ++ int_to_string(fib2(16)) ++ \"\\n\")\n print!(\"fib4(16) = \" ++ int_to_string(fib4(16)) ++ \"\\n\")\n test5!()\n return 0\n}\n\nfunc fib1(n : Int) -> Int {\n if (n <= 1) {\n return 1\n } else {\n return fib1(n-1) + fib1(n-2)\n }\n}\n\nfunc fib2(n : Int) -> Int {\n var r\n if (n <= 1) {\n r = 1\n } else {\n r = fib2(n-1) + fib2(n-2)\n }\n\n return r\n}\n\nfunc fib4(n : Int) -> Int {\n var r\n if (n <= 1) {\n var m = \"fish\"\n r = 1\n } else {\n var m = n\n r = fib4(m-1) + fib4(m-2)\n }\n\n return r\n}\n\nfunc test5() uses IO {\n print!(beer(10) ++ \"\\n\")\n print!(beer(5) ++ \"\\n\")\n print!(beer(1) ++ \"\\n\")\n print!(beer(0) ++ \"\\n\")\n print!(beer(-1) ++ \"\\n\")\n}\n\n/* \n * Test switches that provide multiple values\n * Test wildcard matches\n * Test negative patterns\n */\nfunc beer(n : Int) -> String {\n // This could be an expression but those are tested in match_2.p\n var beer_str\n var panic\n if (n < 0) {\n beer_str = \"You owe someone a beer!\"\n panic = \"Better repay them!\"\n } else if (n == 0) {\n beer_str = \"No more beer!\"\n panic = \"PANIC!\"\n } else if (n == 1) {\n beer_str = \"Only one beer left.\"\n panic = \"worry...\"\n } else {\n beer_str = int_to_string(n) ++ \" more beers left.\"\n panic = \"\"\n }\n\n return beer_str ++ \" \" ++ panic\n}\n\n" }, { "path": "tests/language/list.exp", "content": "15\n215\n4215\n" }, { "path": "tests/language/list.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule List\n\nentrypoint\nfunc main() uses IO -> Int {\n var list1 = [1, 2, 3, 4, 5]\n print!(int_to_string(reduce(add, list1, 0)) ++ \"\\n\")\n\n var list2 = [200 | list1]\n print!(int_to_string(reduce(add, list2, 0)) ++ \"\\n\")\n\n var list3 = [4000, 200 | list1]\n print!(int_to_string(reduce(add, list3, 0)) ++ \"\\n\")\n\n // list4 = [1..10]\n // print!(int_to_string(reduce(add, list4, 0)) ++ \"\\n\")\n\n return 0\n}\n\nfunc reduce(f : func('a, 'a) -> ('a), l : List('a), acc0 : 'a) -> 'a\n{\n match (l) {\n [] -> { return acc0 }\n [var x | var xs] -> {\n var acc = f(x, acc0)\n return reduce(f, xs, acc)\n }\n }\n}\n\nfunc add(a : Int, b : Int) -> Int { return a + b }\n\n" }, { "path": "tests/language/match/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[match_1]\ntype = program\nmodules = [Match_1]\n\n[match_2]\ntype = program\nmodules = [Match_2]\n\n[match_empty_case]\ntype = program\nmodules = [MatchEmptyCase]\n\n[unpack_1]\ntype = program\nmodules = [Unpack_1]\n\n" }, { "path": "tests/language/match/match_1.exp", "content": "fib1(16) = 1597\nfib2(16) = 1597\nfib3(16) = 1597\nfib4(16) = 1597\n10 more beers left. \n5 more beers left. \nOnly one beer left. worry...\nNo more beer! PANIC!\nYou owe someone a beer! Better repay them!\n0 is zero\n5 is more\n" }, { "path": "tests/language/match/match_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Match_1\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"fib1(16) = \" ++ int_to_string(fib1(16)) ++ \"\\n\")\n print!(\"fib2(16) = \" ++ int_to_string(fib2(16)) ++ \"\\n\")\n print!(\"fib3(16) = \" ++ int_to_string(fib3(16)) ++ \"\\n\")\n print!(\"fib4(16) = \" ++ int_to_string(fib4(16)) ++ \"\\n\")\n test5!()\n test6!()\n return 0\n}\n\nfunc fib1(n : Int) -> Int {\n match (n) {\n 0 -> {\n return 1\n }\n 1 -> {\n return 1\n }\n var m -> {\n return fib1(m-1) + fib1(m-2)\n }\n }\n}\n\nfunc fib2(n : Int) -> Int {\n var r\n match (n) {\n 0 -> {\n r = 1\n }\n 1 -> {\n r = 1\n }\n var m -> {\n r = fib2(m-1) + fib2(m-2)\n }\n }\n\n return r\n}\n\nfunc fib3(n : Int) -> Int {\n var r\n match (n) {\n 0 -> {\n r = 1\n }\n 1 -> {\n var m = 1\n r = m\n }\n var m -> {\n r = fib3(m-1) + fib3(m-2)\n }\n }\n\n return r\n}\n\nfunc fib4(n : Int) -> Int {\n var r\n match (n) {\n 0 -> {\n r = 1\n }\n 1 -> {\n var m = \"fish\"\n r = 1\n }\n var m -> {\n r = fib4(m-1) + fib4(m-2)\n }\n }\n\n return r\n}\n\nfunc test5() uses IO {\n print!(beer(10) ++ \"\\n\")\n print!(beer(5) ++ \"\\n\")\n print!(beer(1) ++ \"\\n\")\n print!(beer(0) ++ \"\\n\")\n print!(beer(-1) ++ \"\\n\")\n}\n\n/* \n * Test switches that provide multiple values\n * Test wildcard matches\n * Test negative patterns\n */\nfunc beer(n : Int) -> String {\n var beer_str\n var panic\n match (n) {\n -1 -> {\n beer_str = \"You owe someone a beer!\"\n panic = \"Better repay them!\"\n }\n 0 -> {\n beer_str = \"No more beer!\"\n panic = \"PANIC!\"\n }\n 1 -> {\n beer_str = \"Only one beer left.\"\n panic = \"worry...\"\n }\n _ -> {\n beer_str = int_to_string(n) ++ \" more beers left.\"\n panic = \"\"\n }\n }\n\n return beer_str ++ \" \" ++ panic\n}\n\nfunc test6() uses IO {\n func t(a : Int) -> String {\n var b\n var str\n match (a) {\n 0 -> {\n b = 0\n str = \"zero\"\n }\n // Matches anything and binds it to b which is visible outside.\n b -> {\n str = \"more\"\n }\n }\n\n return int_to_string(b) ++ \" is \" ++ str ++ \"\\n\"\n }\n\n print!(t(0))\n print!(t(5))\n}\n\n" }, { "path": "tests/language/match/match_2.exp", "content": "10 more beers left. \n5 more beers left. \nOnly one beer left. worry...\nNo more beer! PANIC!\nYou owe someone a beer! Better repay them!\n10 more beers left. \n5 more beers left. \nOnly one beer left. worry...\nNo more beer! PANIC!\nYou owe someone a beer! Better repay them!\n10 more beers left. \n5 more beers left. \nOnly one beer left. worry...\nNo more beer! PANIC!\nYou owe someone a beer! Better repay them!\n10 more beers left. \n5 more beers left. \nOnly one beer left. worry...\nNo more beer! PANIC!\nYou owe someone a beer! Better repay them!\n" }, { "path": "tests/language/match/match_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Match_2\n\nentrypoint\nfunc main() uses IO -> Int {\n func test(beer : func(Int) -> String) uses IO {\n print!(beer(10) ++ \"\\n\")\n print!(beer(5) ++ \"\\n\")\n print!(beer(1) ++ \"\\n\")\n print!(beer(0) ++ \"\\n\")\n print!(beer(-1) ++ \"\\n\")\n\n }\n\n test!(beer1)\n test!(beer2)\n test!(beer3)\n test!(beer4)\n\n return 0\n}\n\nfunc beer1(n : Int) -> String {\n // This match expression returns two items.\n var beer_str, var panic = match (n) {\n -1 -> \"You owe someone a beer!\",\n \"Better repay them!\"\n 0 -> \"No more beer!\",\n \"PANIC!\"\n 1 -> \"Only one beer left.\",\n \"worry...\"\n _ -> int_to_string(n) ++ \" more beers left.\",\n \"\"\n }\n\n return beer_str ++ \" \" ++ panic\n}\n\nfunc beer2(n : Int) -> String {\n var beer_str, var panic =\n if (n < 0) then\n \"You owe someone a beer!\",\n \"Better repay them!\"\n else if (n == 1) then\n \"Only one beer left.\",\n \"worry...\"\n else if (n == 0) then\n \"No more beer!\",\n \"PANIC!\"\n else\n int_to_string(n) ++ \" more beers left.\",\n \"\"\n\n return beer_str ++ \" \" ++ panic\n}\n\nfunc beer3(n : Int) -> String {\n var beer_str, var panic =\n // Check that different arms of the if-then-else can can have\n // different expressions although the expression on the else branch\n // returns 2 items.\n if (n < 0) then\n \"You owe someone a beer!\",\n \"Better repay them!\"\n else beer3_aux(n)\n\n return beer_str ++ \" \" ++ panic\n}\n\nfunc beer4(n : Int) -> String {\n var beer_str, var panic =\n // Check that different arms of the if-then-else can can have\n // different expressions although the expression on the else branch\n // returns 2 items.\n match (n) {\n -1 -> \"You owe someone a beer!\",\n \"Better repay them!\"\n _ -> beer3_aux(n)\n }\n\n return beer_str ++ \" \" ++ panic\n}\n\n// This can work to return multiple values.\nfunc beer3_aux(n : Int) -> (String, String) {\n return if (n == 0) then\n \"No more beer!\",\n \"PANIC!\"\n else if (n == 1) then\n \"Only one beer left.\",\n \"worry...\"\n else\n int_to_string(n) ++ \" more beers left.\",\n \"\"\n}\n\n" }, { "path": "tests/language/match/match_bad_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[match_bad_1]\ntype = program\nmodules = [Match_Bad_1]\n\n" }, { "path": "tests/language/match/match_bad_1.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown variable or constructor 'yy'\nContext: ../match_bad_1.p:13\nplzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/match/match_bad_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Match_Bad_1\n\nexport\nfunc main() uses IO -> Int {\n var x = 3\n var y\n match (x) {\n 3 -> {\n y = 2\n }\n // yy does not exist\n yy -> {\n y = yy * 26\n }\n }\n\n print!(int_to_string(y))\n return 0\n}\n\n" }, { "path": "tests/language/match/match_bad_2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[match_bad_2]\ntype = program\nmodules = [Match_Bad_2]\n\n" }, { "path": "tests/language/match/match_bad_2.exp", "content": "A feature required by your program is currently unimplemented,\nhowever this is something we hope to implement in the future. Sorry\n\nFeature: Cannot handle some branches returning and others falling-through\nContext: ../match_bad_2.p:13\nLocation: predicate `pre.to_core.pre_to_core_stmt'/7\nFile: pre.to_core.m\n" }, { "path": "tests/language/match/match_bad_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Match_Bad_2\n\nexport\nfunc main() uses IO -> Int {\n var x = 3\n var y\n match (x) {\n 3 -> {\n y = 2\n return 4\n }\n var yy -> {\n y = yy * 26\n }\n }\n\n print!(int_to_string(y))\n return 0\n}\n\n" }, { "path": "tests/language/match/match_bad_3.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[match_bad_3]\ntype = program\nmodules = [Match_Bad_3]\n\n" }, { "path": "tests/language/match/match_bad_3.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Variable 'a' already defined\nContext: ../match_bad_3.p:15\nplzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/match/match_bad_3.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Match_Bad_3\n\ntype Foo = Foo ( a : Int, b : Int )\n\nexport\nfunc main() uses IO -> Int {\n var x = Foo(2, 170)\n var y\n match (x) {\n // Error, variable used twice in the same pattern\n Foo(var a, var a) -> {\n y = a + a\n }\n }\n\n print!(\"Number is \" ++ int_to_string(y) ++ \"\\n\")\n return 0\n}\n\n" }, { "path": "tests/language/match/match_bad_error_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST todo Pattern match on multiple levels\n# PLZTEST type compile_failure \n\n[match_bad_error_1]\ntype = program\nmodules = [MatchBadError1]\n" }, { "path": "tests/language/match/match_bad_error_1.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: The variable 'varctorname' is already defined\nContext: ../match_bad_error_1.p:23\nplzc location: predicate `pre.from_ast.ast_to_pre_stmt_var'/9\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/match/match_bad_error_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule MatchBadError1\n\nexport\nfunc main() uses IO -> Int {\n test7!()\n return 0\n}\n\ntype TypeExists = varctorname\n\nfunc test7() uses IO {\n func t(a : Int) -> String {\n // This generates an error from the compiler, it's the wrong error\n // since it's a constructor that's already defined, but maybe it\n // should be a warning when a *local variable* does this to another\n // symbol?\n var varctorname\n var str\n match (a) {\n 0 -> {\n varctorname = 0\n str = \"zero\"\n }\n // Same as test6 except this name is also a constructor name,\n // but eh compiler will choose the type.\n varctorname -> {\n str = \"more\"\n }\n }\n\n return int_to_string(varctorname) ++ \" is \" ++ str ++ \"\\n\"\n }\n\n print!(t(0))\n print!(t(5))\n}\n\n" }, { "path": "tests/language/match/match_empty_case.exp", "content": "Hello\n" }, { "path": "tests/language/match/match_empty_case.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule MatchEmptyCase\n\nentrypoint\nfunc main() uses IO -> Int {\n var x = 3\n if (x == 4) {\n // The compiler would crash for an empty case like this.\n } else {\n print!(\"Hello\\n\")\n }\n\n match (x) {\n 0 -> { print!(\"bye?\") }\n // The compiler would crash for an empty case like this.\n 3 -> { }\n _ -> { print!(\"hello?\") }\n }\n\n return 0\n}\n\n" }, { "path": "tests/language/match/match_multiple.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST todo Pattern match on multiple levels\n# PLZTEST type compile_failure \n\n[match_multiple]\ntype = program\nmodules = [MatchMultiple]\n" }, { "path": "tests/language/match/match_multiple.exp", "content": "A feature required by your program is currently unimplemented,\nhowever this is something we hope to implement in the future. Sorry\n\nFeature: Nested pattern matching (constructor within other pattern)\nLocation: predicate `pre.to_core.make_pattern_arg_var'/4\nFile: pre.to_core.m\n" }, { "path": "tests/language/match/match_multiple.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule MatchMultiple \n\nexport\nfunc main() uses IO -> Int {\n var list1 = [1, 2, 3, 4, 5]\n print!(int_to_string(reduce(add, list1)) ++ \"\\n\")\n\n return 0\n}\n\nfunc reduce(f : func(Int, Int) -> (Int), l : List(Int)) -> Int\n{\n match (l) {\n [] -> { return 0 }\n [var x] -> { return x }\n [var a, var b | var xs ] -> { return add(a, reduce(f, [b | xs])) }\n }\n}\n\nfunc add(a : Int, b : Int) -> Int { return a + b }\n\n" }, { "path": "tests/language/match/unpack_1.exp", "content": "x part is 3\np1 + p2 = 1, 9\n" }, { "path": "tests/language/match/unpack_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Unpack_1\n\nentrypoint\nfunc main() uses IO -> Int {\n test1!()\n test2!()\n return 0\n}\n\ntype Point = Point(x : Int, y : Int)\n\nfunc test1() uses IO {\n // Initially we could only extract a single variable.\n Point(var x, _) = Point(3, 6)\n print!(\"x part is \" ++ int_to_string(x) ++ \"\\n\")\n}\n\nfunc point_to_str(p : Point) -> String {\n // Test that we can unpack fields from a structure\n Point(var x, var y) = p\n\n return int_to_string(x) ++ \", \" ++ int_to_string(y)\n}\n\nfunc add(a : Point, b : Point) -> Point {\n Point(var x1, var y1) = a\n\n // We can declare the variables before unpacking them, like other\n // asignments.\n var x2\n var y2\n Point(x2, y2) = b\n\n return Point(x1 + x2, y1 + y2)\n}\n\nfunc test2() uses IO {\n var p1 = Point(3, 2)\n var p2 = Point(-2, 7)\n print!(\"p1 + p2 = \" ++ point_to_str(add(p1, p2)) ++ \"\\n\")\n}\n\n" }, { "path": "tests/language/match/unpack_nest.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST todo nested constructors in unpack statements\n# PLZTEST type compile_failure \n\n[unpack_nest]\ntype = program\nmodules = [UnpackNest]\n\n" }, { "path": "tests/language/match/unpack_nest.exp", "content": "A feature required by your program is currently unimplemented,\nhowever this is something we hope to implement in the future. Sorry\n\nFeature: Nested pattern matching (constructor within other pattern)\nLocation: predicate `pre.to_core.make_pattern_arg_var'/4\nFile: pre.to_core.m\n" }, { "path": "tests/language/match/unpack_nest.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule UnpackNest\n\nexport\nfunc main() uses IO -> Int {\n test3!()\n return 0\n}\n\ntype Foo = Foo(a : Bar, b : Int)\n\n// We have to test with the unit type to make an irrefutable pattern\ntype Bar = Bar\n\nfunc foo_to_str(f : Foo) -> String {\n Foo(Bar, var n) = f\n return \"Foo(Bar, \" ++ int_to_string(n) ++ \")\"\n}\n\nfunc test3() uses IO {\n var a = Foo(Bar, 28)\n print!(\"a = \" ++ foo_to_str(a) ++ \"\\n\")\n}\n\n" }, { "path": "tests/language/operators.exp", "content": "27 + 3 = 30\n27 - 3 = 24\n3 - 27 = -24\n5 * 5 = 25\n37 / 5 = 7\n-37 / 5 = -7\n37 / -5 = -7\n-37 / -5 = 7\n37 % 5 = 2\n-37 % 5 = -2\n37 % -5 = 2\n-37 % -5 = -2\n-3 = -3\n12 + 3 * 4 = 24\n12 - (8 + 2) = 2\n6 + 6 == 3 * 4 = True\n5 < 3 = False\n5 > 3 = True\n5 <= 3 = False\n5 >= 3 = True\n5 == 3 = False\n5 != 3 = True\n5 < 4 = False\n5 > 4 = True\n5 <= 4 = False\n5 >= 4 = True\n5 == 4 = False\n5 != 4 = True\n5 < 5 = False\n5 > 5 = False\n5 <= 5 = True\n5 >= 5 = True\n5 == 5 = True\n5 != 5 = False\n5 < 6 = True\n5 > 6 = False\n5 <= 6 = True\n5 >= 6 = False\n5 == 6 = False\n5 != 6 = True\n5 < 7 = True\n5 > 7 = False\n5 <= 7 = True\n5 >= 7 = False\n5 == 7 = False\n5 != 7 = True\nnot True = False\nnot False = True\nFalse and False = False\nFalse and True = False\nTrue and False = False\nTrue and True = True\nFalse or False = False\nFalse or True = True\nTrue or False = True\nTrue or True = True\n" }, { "path": "tests/language/operators.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Operators\n\n/*\n * Please keep this up to date with the documentation in docs/plasma_ref.txt\n */\n\nentrypoint\nfunc main() uses IO -> Int {\n // Arithmetic\n print!(\"27 + 3 = \" ++ int_to_string(27 + 3) ++ \"\\n\")\n print!(\"27 - 3 = \" ++ int_to_string(27 - 3) ++ \"\\n\")\n print!(\"3 - 27 = \" ++ int_to_string(3 - 27) ++ \"\\n\")\n print!(\"5 * 5 = \" ++ int_to_string(5 * 5) ++ \"\\n\")\n print!(\"37 / 5 = \" ++ int_to_string(37 / 5) ++ \"\\n\")\n print!(\"-37 / 5 = \" ++ int_to_string(-37 / 5) ++ \"\\n\")\n print!(\"37 / -5 = \" ++ int_to_string(37 / -5) ++ \"\\n\")\n print!(\"-37 / -5 = \" ++ int_to_string(-37 / -5) ++ \"\\n\")\n print!(\"37 % 5 = \" ++ int_to_string(37 % 5) ++ \"\\n\")\n print!(\"-37 % 5 = \" ++ int_to_string(-37 % 5) ++ \"\\n\")\n print!(\"37 % -5 = \" ++ int_to_string(37 % -5) ++ \"\\n\")\n print!(\"-37 % -5 = \" ++ int_to_string(-37 % -5) ++ \"\\n\")\n print!(\"-3 = \" ++ int_to_string(-3) ++ \"\\n\")\n\n // Order of operations\n print!(\"12 + 3 * 4 = \" ++ int_to_string(12 + 3 * 4) ++ \"\\n\")\n print!(\"12 - (8 + 2) = \" ++ int_to_string(12 - (8 + 2)) ++ \"\\n\")\n print!(\"6 + 6 == 3 * 4 = \" ++ bool_to_string(6 + 6 == 3 * 4) ++ \"\\n\")\n\n // Comparison\n func test_compare(x : Int) uses IO {\n print!(\"5 < \" ++ int_to_string(x) ++ \" = \" ++ \n bool_to_string(5 < x) ++ \"\\n\")\n print!(\"5 > \" ++ int_to_string(x) ++ \" = \" ++ \n bool_to_string(5 > x) ++ \"\\n\")\n print!(\"5 <= \" ++ int_to_string(x) ++ \" = \" ++ \n bool_to_string(5 <= x) ++ \"\\n\")\n print!(\"5 >= \" ++ int_to_string(x) ++ \" = \" ++ \n bool_to_string(5 >= x) ++ \"\\n\")\n print!(\"5 == \" ++ int_to_string(x) ++ \" = \" ++ \n bool_to_string(5 == x) ++ \"\\n\")\n print!(\"5 != \" ++ int_to_string(x) ++ \" = \" ++ \n bool_to_string(5 != x) ++ \"\\n\")\n }\n var list = [3, 4, 5, 6, 7]\n do_list!(test_compare, list)\n\n // Bool\n print!(\"not True = \" ++ bool_to_string(not True) ++ \"\\n\")\n print!(\"not False = \" ++ bool_to_string(not False) ++ \"\\n\")\n func test_and(b1 : Bool, b2 : Bool) uses IO {\n print!(bool_to_string(b1) ++ \" and \" ++ bool_to_string(b2) ++ \" = \"\n ++ bool_to_string(b1 and b2) ++ \"\\n\")\n }\n test_and!(False, False)\n test_and!(False, True)\n test_and!(True, False)\n test_and!(True, True)\n func test_or(b1 : Bool, b2 : Bool) uses IO {\n print!(bool_to_string(b1) ++ \" or \" ++ bool_to_string(b2) ++ \" = \"\n ++ bool_to_string(b1 or b2) ++ \"\\n\")\n }\n test_or!(False, False)\n test_or!(False, True)\n test_or!(True, False)\n test_or!(True, True)\n\n // String append is tested throughout this test anyway.\n\n return 0\n}\n\nfunc do_list(f : func('x) uses IO, l : List('x)) uses IO {\n match (l) {\n [] -> { }\n [var x | var xs] -> {\n f!(x)\n do_list!(f, xs)\n }\n }\n}\n\n" }, { "path": "tests/language/pragma_bad_args.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[pragma_bad_args]\ntype = program\nmodules = [PragmaBadArgs]\n\n" }, { "path": "tests/language/pragma_bad_args.exp", "content": "pragma_bad_args.p:10: Unrecognised argument for this pragma\n" }, { "path": "tests/language/pragma_bad_args.p", "content": "\n/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule PragmaBadArgs \n\npragma foreign_include(\"globly\", \"glorp\")\n\nentrypoint\nfunc hello() uses IO -> Int {\n print!(\"Hello world\\n\")\n return 0\n}\n\n" }, { "path": "tests/language/pragma_unknown_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[pragma_unknown_1]\ntype = program\nmodules = [PragmaUnknown1]\ncompiler_opts = \"--warnings-as-errors\"\n\n" }, { "path": "tests/language/pragma_unknown_1.exp", "content": "pragma_unknown_1.p:9: Warning: Pragma 'sillyname' is unrecognised and will be\n ignored\n" }, { "path": "tests/language/pragma_unknown_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule PragmaUnknown1\n\npragma sillyname(\"skidoo\")\n\nentrypoint func main() uses IO -> Int {\n print!(\"Hello world!\\n\")\n return 0\n}\n\n" }, { "path": "tests/language/pragma_unknown_2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# This still has an unknown pragma but it will be mearly a warning and the\n# program will still execute.\n[pragma_unknown_2]\ntype = program\nmodules = [PragmaUnknown2]\n\n" }, { "path": "tests/language/pragma_unknown_2.exp", "content": "Hello world!\n" }, { "path": "tests/language/pragma_unknown_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule PragmaUnknown2\n\npragma sillyname(\"skidoo\")\n\nentrypoint func main() uses IO -> Int {\n print!(\"Hello world!\\n\")\n return 0\n}\n\n" }, { "path": "tests/language/res/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[resource]\ntype = program\nmodules = [Resource]\n\n" }, { "path": "tests/language/res/multiple_bang.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[multiple_bang]\ntype = program\nmodules = [MultipleBang]\n\n" }, { "path": "tests/language/res/multiple_bang.exp", "content": "multiple_bang.p:12: Statement has more than one ! call\nmultiple_bang.p:16: Statement has more than one ! call\n" }, { "path": "tests/language/res/multiple_bang.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule MultipleBang \n\nexport\nfunc main() uses IO -> Int {\n // Future: Use disjoint resources in the same statement.\n _ = use_env!() + test_gettimeofday!()\n\n // Future: Observe the same or related resources in the same statement.\n // XXX But not use and observe\n var d = test_gettimeofday!() - test_gettimeofday!()\n print!(\"# The difference between two times is: \" ++ int_to_string(d) ++\n \"\\n\")\n\n return 0\n}\n\nfunc use_env() uses Environment -> Int {\n return 0\n}\n\nfunc test_gettimeofday() observes Time -> Int {\n var b, var s, var us = Builtin.gettimeofday!()\n if (b) {\n return s\n } else {\n return -1\n }\n}\n\n" }, { "path": "tests/language/res/resource.exp", "content": "Hello world\nTwo uses of IO\nWithin the same compound statement (the if)\n" }, { "path": "tests/language/res/resource.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Resource \n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"Hello world\\n\")\n\n use_state!()\n\n test_setenv!(\"test_env\", \"test value\")\n\n var time_s = test_gettimeofday!()\n print!(\"# The time is \" ++ int_to_string(time_s) ++ \"s\\n\")\n var r = use_foo!()\n\n // Safe resource use in a sub-statement.\n if (0 == 0) {\n print!(\"Two uses of IO\\n\")\n print!(\"Within the same compound statement (the if)\\n\")\n } else {\n print!(\"Are okay, also okay in different branches\\n\")\n }\n\n return r\n}\n\nfunc use_env() uses Environment -> Int {\n return 0\n}\n\nresource MyState from IO\nresource MySubState from MyState\n\n// Parens are valid but optional here.\nfunc use_state() uses (MySubState) {}\n\n// resource Environment from IO\n\nfunc test_setenv(name : String, value : String) uses Environment {\n _ = setenv!(name, value)\n return\n}\n\n// resource Time from IO\n\nfunc test_gettimeofday() observes Time -> Int {\n var b, var s, var us = Builtin.gettimeofday!()\n if (b) {\n return s\n } else {\n return -1\n }\n}\n\n// define our own resources\nresource Foo from IO\nresource Bar from Foo\nresource Bax from Foo\n\nfunc use_foo() uses Foo -> Int {\n return 0\n}\n\nfunc observe_foo() observes Foo -> Int {\n return observe_bar!()\n}\n\nfunc observe_bar() observes Bar -> Int {\n return 42\n}\n\nfunc use_bar_and_baz() uses (Bar, Bax) -> Int {\n return 43\n}\n\n" }, { "path": "tests/language/res/resource_invalid_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[resource_invalid_1]\ntype = program\nmodules = [ResourceInvalid1]\n" }, { "path": "tests/language/res/resource_invalid_1.exp", "content": "resource_invalid_1.p:20: Warning: Call has a ! but does not need it\nresource_invalid_1.p:12: Call uses or observes a resource but has no !\nresource_invalid_1.p:13: Call uses or observes a resource but has no !\nresource_invalid_1.p:29: One or more resources needed for this call is\n unavailable in this function\nresource_invalid_1.p:36: One or more resources needed for this call is\n unavailable in this function\nresource_invalid_1.p:49: One or more resources needed for this call is\n unavailable in this function\nresource_invalid_1.p:54: One or more resources needed for this call is\n unavailable in this function\n" }, { "path": "tests/language/res/resource_invalid_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ResourceInvalid1 \n\nexport\nfunc main() uses IO -> Int {\n // Calls without bang.\n foo()\n baz()\n\n // These calls are okay.\n foo!()\n baz!()\n\n // Unnecessary bang\n return bar!()\n}\n\nfunc foo() uses IO {\n print!(\"Hello world\\n\")\n}\n\nfunc bar() -> Int {\n // Use of a resource we don't have.\n print!(\"Hi\\n\")\n\n return 3\n}\n\nfunc baz() observes IO {\n // Use of a resource we only have read access to.\n print!(\"Hi baz\\n\")\n}\n\n// Function declares that it uses a resource but doesn't actually need it.\nfunc troz() uses IO -> Int {\n return 6\n}\n\nresource Foo from IO\nresource Bar from Foo\n\nfunc use_bar_call_foo() uses Bar -> Int {\n // We need the parent resource for this call. Bar isn't enough.\n return use_foo!()\n}\n\nfunc use_foo() uses Foo -> Int {\n // We need a sibling resource for this call. Foo isn't enough.\n _ = setenv!(\"abc\", \"xyz\")\n return 3\n}\n\n" }, { "path": "tests/language/res/resource_invalid_2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[resource_invalid_2]\ntype = program\nmodules = [ResourceInvalid2]\n" }, { "path": "tests/language/res/resource_invalid_2.exp", "content": "resource_invalid_2.p:10: Unknown resource 'Fipbib'\n" }, { "path": "tests/language/res/resource_invalid_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ResourceInvalid2 \n\n// Undeclared resource.\nfunc zort() uses Fipbib -> Int {\n return 42\n}\n\n" }, { "path": "tests/language/res/resource_invalid_3.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[resource_invalid_3]\ntype = program\nmodules = [ResourceInvalid3]\n" }, { "path": "tests/language/res/resource_invalid_3.exp", "content": "resource_invalid_3.p:15: Statement has more than one ! call\nresource_invalid_3.p:19: Statement has more than one ! call\nresource_invalid_3.p:22: Statement has more than one ! call\nresource_invalid_3.p:25: Statement has more than one ! call\nresource_invalid_3.p:28: Statement has more than one ! call\nresource_invalid_3.p:31: Statement has more than one ! call\nresource_invalid_3.p:35: Statement has more than one ! call\n" }, { "path": "tests/language/res/resource_invalid_3.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ResourceInvalid3 \n\nexport\nfunc main() uses IO -> Int {\n // These should all fail for different reasons, but right now the\n // implementation doesn't attempt to detect them.\n\n // It's an error to use the same resource twice in the same statement.\n print!(use_io_and_return_string!())\n\n // It's also an error to use a parent and child resource in the same\n // statement.\n print!(int_to_string(test_uses_time!()))\n\n // Or to use and observe related resources.\n print!(int_to_string(observe_io!()))\n\n // or any ancestor and child (using/using).\n print!(int_to_string(test_uses_time!()))\n\n // or any ancestor and child (using/observing).\n print!(int_to_string(test_gettimeofday!()))\n\n // Like above but the other way around.\n _ = use_env!() + observe_io!()\n\n if (3 == 3) {\n // Any test within a compound statement.\n var x = use_env!() + observe_io!()\n } else {}\n\n return 0\n}\n\nfunc use_io_and_return_string() uses IO -> String {\n return \"Hello world\\n\"\n}\n\n\nfunc test_uses_time() uses Time -> Int {\n return test_gettimeofday!()\n}\n\nfunc test_gettimeofday() observes Time -> Int {\n var ok, var s, _ = Builtin.gettimeofday!()\n if (ok) {\n return s\n } else {\n return 0\n }\n}\n\nfunc observe_io() observes IO -> Int {\n return 4\n}\n\nfunc use_env() uses Environment -> Int {\n return 12\n}\n\n" }, { "path": "tests/language/return.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[return]\ntype = program\nmodules = [Return]\n\n" }, { "path": "tests/language/return.exp", "content": "return.p:12: Function returns 1 results but this path has no return statement\nreturn.p:16: Function returns 1 results but this path has no return statement\n" }, { "path": "tests/language/return.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Return\n\nfunc foo() uses IO -> Int {\n // The arity of the expression matches, but there's no explicit return\n // statement. This was silently accepted as correct.\n return1()\n}\n\n// The same but when there's no statements at all.\nfunc bar() -> Int { }\n\nfunc return1() -> Int {\n return 3\n}\n\n" }, { "path": "tests/language/string.exp", "content": "This is a string\nAppend: abcdef\nThe End.\nA codepoint: .\nA codepoint: \n\nA codepoint: q\n" }, { "path": "tests/language/string.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule String\n\nentrypoint\nfunc example() uses IO -> Int { \n // We can print strings\n print!(\"This is a string\\n\")\n \n // Assign them to variables\n var s1 = \"abc\"\n var s2 = \"def\"\n\n // append them\n print!(\"Append: \" ++ s1 ++ s2 ++ \"\\n\")\n\n // A single character in quotes can be a string\n var dot = \".\"\n var nl = \"\\n\"\n print!(\"The End\" ++ dot ++ nl)\n\n // Or a codepoint (aka character)\n print!(\"A codepoint: \" ++ codepoint_to_string(\".\") ++ nl)\n print!(\"A codepoint: \" ++ codepoint_to_string(\"\\n\") ++ nl)\n print!(\"A codepoint: \" ++ codepoint_to_string(\n Builtin.int_to_codepoint(113)) ++ nl)\n\n return 0\n}\n\n" }, { "path": "tests/language/types/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[constructor_overload]\ntype = program\nmodules = [ConstructorOverload]\n\n[enum]\ntype = program\nmodules = [Enum]\n\n[parametric]\ntype = program\nmodules = [Parametric]\n\n[playing_card]\ntype = program\nmodules = [PlayingCard]\n\n[polymorphic]\ntype = program\nmodules = [Polymorphic]\n\n[recursive]\ntype = program\nmodules = [Recursive]\n\n[tagging1]\ntype = program\nmodules = [Tagging1]\n\n[tagging2]\ntype = program\nmodules = [Tagging2]\n\n" }, { "path": "tests/language/types/bug_375.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[bug_375]\ntype = program\nmodules = [Bug375]\n\n" }, { "path": "tests/language/types/bug_375.exp", "content": "bug_375.p:22: \"func(C()) -> Builtin.Bool()\" and \"func(SP()) -> Builtin.Bool()\"\n are not the same, because\n \"C()\" and \"SP()\" are not the same\nbug_375.p:36: \"func(C()) -> Builtin.Bool()\" and \"func(SP()) -> Builtin.Bool()\"\n are not the same, because\n \"C()\" and \"SP()\" are not the same\n" }, { "path": "tests/language/types/bug_375.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Bug375\n\ntype C = C\ntype SP = SP\n\nfunc sp_is_a(sp : SP) -> Bool { return False }\n\n// A mistaken type here.\nfunc sp_to_c(sp : SP) -> SP { return SP }\n\n// Fixed\nfunc sp_to_c_good(sp : SP) -> C { return C }\n\nfunc find_last(test : func(C) -> Bool,\n string : String) {\n func loop(pos : SP) -> SP {\n if sp_is_a(pos) {\n return pos\n // Is not detected as an error here.\n } else if test(sp_to_c(pos)) {\n return pos\n } else {\n return pos\n }\n }\n}\n\nfunc find_last2(test : func(C) -> Bool,\n string : String) {\n func loop(pos : SP) -> SP {\n // This version does catch the error.\n if test(sp_to_c(pos)) {\n return pos\n } else {\n return pos\n }\n }\n}\n\nfunc find_last3(test : func(C) -> Bool,\n string : String) {\n func loop(pos : SP) -> SP {\n // This version has no error.\n if test(sp_to_c_good(pos)) {\n return pos\n } else {\n return pos\n }\n }\n}\n" }, { "path": "tests/language/types/closure_infer_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST todo type inference\n# PLZTEST type compile_failure \n\n[closure_infer_1]\ntype = program\nmodules = [ClosureInfer1]\n\n" }, { "path": "tests/language/types/closure_infer_1.exp", "content": "closure_infer_1.p:22: Ambigious types\n The unbound solver variables are:\n 'Sv_greet_1 = func(string, _)\n 'Sv_opening_4 = _\n\n The unresolved solver clauses are:\n 'Sv_greet_1 = func('Sv_name_6, 'Sv_opening_4)\n" }, { "path": "tests/language/types/closure_infer_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ClosureInfer1\n\nexport\nfunc main() uses IO -> Int {\n var salutation = \"G'day\"\n\n func greet(name : String, opening : String) uses IO {\n print!(salutation ++ \" \" ++ name ++ \" \" ++ opening ++ \"\\n\")\n }\n\n var opening = \"How's it goin?\"\n\n // Because closures are typechecked before their containing functions,\n // not enough type information is passed into this closure from the\n // outside and it has an ambigious type.\n func greet2(name : String) uses IO {\n greet!(name, opening)\n }\n\n greet2!(\"Paul\")\n greet2!(\"James\")\n\n return 0\n}\n\n" }, { "path": "tests/language/types/closure_infer_2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST todo type inference\n# PLZTEST type compile_failure \n\n[closure_infer_2]\ntype = program\nmodules = [ClosureInfer2]\n\n" }, { "path": "tests/language/types/closure_infer_2.exp", "content": "closure_infer_2.p:21: \"func(func(int) -> int, Builtin.Maybe(_))\n -> Builtin.Maybe(string)\" and\n \"func(func(int) -> string, Builtin.Maybe(string))\n -> Builtin.Maybe(string)\" are not the same, because\n \"func(int) -> int\" and \"func(int) -> string\" are not the\n same, because\n \"int\" and \"string\" are not the same\nclosure_infer_2.p:33: \"func(_, Builtin.Maybe(int)) -> Builtin.Maybe(string)\"\n and\n \"func(func(int) -> int, Builtin.Maybe(int))\n -> Builtin.Maybe(\n int)\"\n are not the same, because\n \"Builtin.Maybe(string)\" and \"Builtin.Maybe(int)\" are not\n the same, because\n \"string\" and \"int\" are not the same\n" }, { "path": "tests/language/types/closure_infer_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ClosureInfer2 \n\n/*\n * The type checker seems to be giving an over-specific type to some of the\n * higher order code here that later causes a type conflict.\n */\nfunc test1() uses IO -> String {\n func map(f : func('a) -> 'b, m : Maybe('a)) -> Maybe('b) {\n return match(m) {\n None -> None\n Some(var x) -> Some(f(x))\n }\n }\n\n return maybe_str(map(int_to_string, map(plus1, None)))\n}\n\n// There's a different error when you pass a Some(3) in\nfunc test2() uses IO -> String {\n func map(f : func('a) -> 'b, m : Maybe('a)) -> Maybe('b) {\n return match(m) {\n None -> None\n Some(var x) -> Some(f(x))\n }\n }\n\n return maybe_str(map(int_to_string, map(plus1, Some(3))))\n}\n\nfunc plus1(x : Int) -> Int {\n return x + 1\n}\n\nfunc maybe_str(m : Maybe(String)) -> String {\n return match(m) {\n None -> \"None\"\n Some(var x) -> \"Some(\" ++ x ++ \")\"\n }\n}\n\n" }, { "path": "tests/language/types/constructor_duplicate.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[constructor_duplicate]\ntype = program\nmodules = [ConstructorDuplicate]\n\n" }, { "path": "tests/language/types/constructor_duplicate.exp", "content": "constructor_duplicate.p:10: This type already has a constructor named\n 'ConstructorDuplicate.Diamonds'\n" }, { "path": "tests/language/types/constructor_duplicate.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ConstructorDuplicate \n\n// Simple enum, but it is invalid because a constructor is duplicated.\ntype Suit = Hearts | Diamonds | Diamonds | Clubs\n\nfunc main() uses IO -> Int {\n print!(\"Queen of \" ++ suit_str(Hearts) ++ \"\\n\")\n print!(\"Ace of \" ++ suit_str(Clubs) ++ \"\\n\")\n return 0\n}\n\nfunc suit_str(s : Suit) -> String {\n match (s) {\n Hearts -> { return \"Hearts\" }\n Diamonds -> { return \"Diamonds\" }\n Clubs -> { return \"Clubs\" }\n }\n}\n\n" }, { "path": "tests/language/types/constructor_overload.exp", "content": "Queen of Hearts\nAce of Spades\n" }, { "path": "tests/language/types/constructor_overload.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ConstructorOverload \n\n// Simple enum\ntype Suit = Hearts | Diamonds | Spades | Clubs\ntype RedSuit = Hearts | Diamonds\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"Queen of \" ++ suit_str(Hearts) ++ \"\\n\")\n print!(\"Ace of \" ++ suit_str(Spades) ++ \"\\n\")\n return 0\n}\n\nfunc suit_str(s : Suit) -> String {\n match (s) {\n Hearts -> { return \"Hearts\" }\n Diamonds -> { return \"Diamonds\" }\n Spades -> { return \"Spades\" }\n Clubs -> { return \"Clubs\" }\n }\n}\n\n\n\n" }, { "path": "tests/language/types/enum.exp", "content": "Queen of Hearts\nAce of Spades\n" }, { "path": "tests/language/types/enum.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Enum\n\n// Simple enum\ntype Suit = Hearts | Diamonds | Spades | Clubs\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"Queen of \" ++ suit_str(Hearts) ++ \"\\n\")\n print!(\"Ace of \" ++ suit_str(Spades) ++ \"\\n\")\n return 0\n}\n\nfunc suit_str(s : Suit) -> String {\n match (s) {\n Hearts -> { return \"Hearts\" }\n Diamonds -> { return \"Diamonds\" }\n Spades -> { return \"Spades\" }\n Clubs -> { return \"Clubs\" }\n }\n}\n\n" }, { "path": "tests/language/types/ho_bad_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[ho_bad_1]\ntype = program\nmodules = [HO_Bad_1]\n\n" }, { "path": "tests/language/types/ho_bad_1.exp", "content": "ho_bad_1.p:14: \"func(int) -> string\" and \"func(string) -> string\" are not the\n same, because\n \"int\" and \"string\" are not the same\n" }, { "path": "tests/language/types/ho_bad_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HO_Bad_1 \n\nfunc main() uses IO -> Int {\n // Only one of these will be raised until compiler error handling is\n // improved.\n\n // Type mismatched ho call passed in\n print!(apply(hello_msg, 3))\n\n // Return type mismatch:\n print!(int_to_string(apply(hello_msg, \"ho\")))\n\n // TODO different function types in homogenous array.\n\n return 0\n}\n\nfunc hello_msg(name : String) -> String {\n return \"Hello \" ++ name ++ \"\\n\"\n}\n\nfunc apply(f : func('a) -> ('b), arg : 'a) -> 'b {\n return f(arg)\n}\n\n" }, { "path": "tests/language/types/ho_bad_2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[ho_bad_2]\ntype = program\nmodules = [HO_Bad_2]\n\n" }, { "path": "tests/language/types/ho_bad_2.exp", "content": "ho_bad_2.p:19: \"func('a) -> 'a\" and \"func('a) -> 'b\" are not the same, because\n \"'a\" and \"'b\" are not the same\n" }, { "path": "tests/language/types/ho_bad_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HO_Bad_2\n\nfunc main() uses IO -> Int {\n print!(apply(hello_msg, \"Paul\"))\n\n return 0\n}\n\nfunc hello_msg(name : String) -> String {\n return \"Hello \" ++ name ++ \"\\n\"\n}\n\nfunc apply(f : func('a) -> ('b), arg : 'a) -> 'a {\n // Return type of f doesn't match apply's return type.\n return f(arg)\n}\n\n" }, { "path": "tests/language/types/ho_bad_3.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[ho_bad_3]\ntype = program\nmodules = [HO_Bad_3]\n\n" }, { "path": "tests/language/types/ho_bad_3.exp", "content": "ho_bad_3.p:12: \"func(string) -> string\" and \"func(int, string) -> string\" are\n not the same\n" }, { "path": "tests/language/types/ho_bad_3.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HO_Bad_3\n\nfunc main() uses IO -> Int {\n // hello_msg takes one argument but apply expects its first argument to\n // take two.\n print!(apply(hello_msg, \"Paul\"))\n\n return 0\n}\n\nfunc hello_msg(name : String) -> String {\n return \"Hello \" ++ name ++ \"\\n\"\n}\n\nfunc apply(f : func(Int, 'a) -> ('b), arg : 'a) -> 'b {\n return f(3, arg)\n}\n\n" }, { "path": "tests/language/types/ho_bad_4.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[ho_bad_4]\ntype = program\nmodules = [HO_Bad_4]\n\n" }, { "path": "tests/language/types/ho_bad_4.exp", "content": "ho_bad_4.p:11: \"func(string) -> (string, int)\" and \"func(string) -> string\" are\n not the same\n" }, { "path": "tests/language/types/ho_bad_4.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HO_Bad_4\n\nfunc main() uses IO -> Int {\n // hello_msg returns one argument but apply expects it to return two.\n print!(apply(hello_msg, \"Paul\"))\n\n return 0\n}\n\nfunc hello_msg(name : String) -> String {\n return \"Hello \" ++ name ++ \"\\n\"\n}\n\nfunc apply(f : func('a) -> ('b, Int), arg : 'a) -> 'b {\n var b, _ = f(arg)\n return b\n}\n\n" }, { "path": "tests/language/types/ho_bad_5.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[ho_bad_5]\ntype = program\nmodules = [HO_Bad_5]\n\n" }, { "path": "tests/language/types/ho_bad_5.exp", "content": "ho_bad_5.p:21: \"func(_) -> _\" and \"func(_) -> (_, _)\" are not the same\n" }, { "path": "tests/language/types/ho_bad_5.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HO_Bad_5\n\nfunc main() uses IO -> Int {\n print!(apply(hello_msg, \"Paul\"))\n\n return 0\n}\n\nfunc hello_msg(name : String) -> String {\n return \"Hello \" ++ name ++ \"\\n\"\n}\n\nfunc apply(f : func('a) -> ('b), arg : 'a) -> 'b {\n // Expect f to return two values when it returns only one.\n var b, _ = f(arg)\n return b\n}\n\n" }, { "path": "tests/language/types/ho_bad_6.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[ho_bad_6]\ntype = program\nmodules = [HO_Bad_6]\n\n" }, { "path": "tests/language/types/ho_bad_6.exp", "content": "ho_bad_6.p:21: \"func(_) -> _\" and \"func(_, int) -> _\" are not the same\n" }, { "path": "tests/language/types/ho_bad_6.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HO_Bad_6\n\nfunc main() uses IO -> Int {\n print!(apply(hello_msg, \"Paul\"))\n\n return 0\n}\n\nfunc hello_msg(name : String) -> String {\n return \"Hello \" ++ name ++ \"\\n\"\n}\n\nfunc apply(f : func('a) -> ('b), arg : 'a) -> 'b {\n // Expect f to take two paramers when it takes only 1.\n var b = f(arg, 5)\n return b\n}\n\n" }, { "path": "tests/language/types/occurs1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[occurs1]\ntype = program\nmodules = [Occurs1]\n\n" }, { "path": "tests/language/types/occurs1.exp", "content": "occurs1.p:11: \"int\" and \"Occurs(int)\" are not the same\n" }, { "path": "tests/language/types/occurs1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Occurs1\n\ntype Occurs('x) = Occurs ( v : 'x )\n\nfunc occurs1(a : Occurs('o), b : 'o) -> Bool {\n return a == b \n}\n\n" }, { "path": "tests/language/types/occurs2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[occurs2]\ntype = program\nmodules = [Occurs2]\n\n" }, { "path": "tests/language/types/occurs2.exp", "content": "occurs2.p:11: Type error: The type \"'Sv_a_0\" cannot be bound to\n \"Occurs('Sv_a_0)\" because it can't contain itself.\n" }, { "path": "tests/language/types/occurs2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Occurs2\n\ntype Occurs('x) = Occurs ( v : 'x )\n\nfunc occurs2(a : Occurs('o)) -> 'o {\n return a\n}\n\n" }, { "path": "tests/language/types/occurs3.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[occurs3]\ntype = program\nmodules = [Occurs3]\n\n" }, { "path": "tests/language/types/occurs3.exp", "content": "occurs3.p:11: Type error: The type \"'Sv_a_0\" cannot be bound to\n \"Occurs('Sv_a_0)\" because it can't contain itself.\n" }, { "path": "tests/language/types/occurs3.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Occurs3\n\ntype Occurs('x) = Occurs ( v : 'x )\n\nfunc occurs3(a : Occurs('o), b : 'o, c : Bool) uses IO {\n var r\n if (c) {\n r = a\n } else {\n r = b\n }\n sink!(r)\n}\n\nfunc sink(o : Occurs('o)) uses IO { }\n\n" }, { "path": "tests/language/types/occurs4.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[occurs4]\ntype = program\nmodules = [Occurs4]\n\n" }, { "path": "tests/language/types/occurs4.exp", "content": "occurs4.p:15: Type error: The type \"'Sv_o1_0\" cannot be bound to\n \"Occurs('Sv_o1_0)\" because it can't contain itself.\n" }, { "path": "tests/language/types/occurs4.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Occurs4\n\ntype Occurs('x) = Occurs ( v : 'x ) | Nil\n\nfunc occurs4() uses IO{\n var o1 = faucet()\n match (o1) {\n Occurs(var o2) -> {\n if (eq(o1, o2)) {\n print!(\"True\")\n } else {\n print!(\"False\")\n }\n }\n Nil -> { Builtin.die!(\"Die!\") }\n }\n}\n\nfunc eq(x : 'a, y : 'a) -> Bool {\n return True\n}\n\nfunc faucet() -> Occurs('o) { \n return Nil\n}\n\n/*\n * We should also test the occurs check on function types, but the test can't\n * be described in Plasma yet without more functional features.\n */\n\n" }, { "path": "tests/language/types/occurs5.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[occurs5]\ntype = program\nmodules = [Occurs5]\n\n" }, { "path": "tests/language/types/occurs5.exp", "content": "occurs5.p:13: \"Occurs1(_)\" and \"'o\" are not the same\n" }, { "path": "tests/language/types/occurs5.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Occurs5\n\ntype Occurs1('x) = Occurs1 ( v : 'x )\ntype Occurs2('x) = Occurs2 ( v : 'x )\ntype Occurs3('x) = Occurs3 ( v : 'x )\n\nfunc occurs5(a : Occurs1(Occurs2(Occurs3('o))), b : 'o, c : Bool) uses IO {\n var r\n // This doesn't seem to be failing due to the occurs check, but it does\n // cause a type error so at least the compiler won't accept this invalid\n // program.\n if (c) {\n r = a\n } else {\n r = b\n }\n sink!(r)\n}\n\nfunc sink(a : 'a) uses IO { }\n\n" }, { "path": "tests/language/types/parametric.exp", "content": "4\n3\n" }, { "path": "tests/language/types/parametric.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Parametric \n\nentrypoint\nfunc main() uses IO -> Int {\n var list1 = MyCons(1, MyCons(2, MyCons(3, MyCons(4, MyNil))))\n print!(int_to_string(list_length(list1)) ++ \"\\n\")\n \n var list2 = MyCons(\"A\", MyCons(\"B\", MyCons(\"C\", MyNil)))\n print!(int_to_string(list_length(list2)) ++ \"\\n\")\n\n // Oh, if we use strings of length one the typechecker can't decide if\n // these are strings of charaters. It doesn't matter for our program.\n // So by doing this we give the typechecker enough information to\n // resolve it.\n _ = MyCons(\"a string\", list2)\n \n return 0\n}\n\n// Demonstrate a parametric type.\ntype MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('a) )\n\nfunc list_length(l : MyList('t)) -> Int {\n match (l) {\n MyNil -> { return 0 }\n MyCons(_, var rest) -> { return 1 + list_length(rest) }\n }\n}\n\n// Attempt to confuse type inference:\n\n// This type has constructor symbols with the same names as above.\ntype OtherList('a) = MyCons ( ohead : 'a, otail : OtherList('a) ) | ONil\n\n// Again with different type variable nmaes,\ntype OtherList2('b) = MyCons ( o2head : 'b, o2tail : OtherList('b) ) | ONil\n\n\n" }, { "path": "tests/language/types/playing_card.exp", "content": "Queen of Hearts\nAce of Spades\n3 of Clubs\nINVALID of Diamonds\n" }, { "path": "tests/language/types/playing_card.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule PlayingCard \n\n// Simple enum\ntype Suit = Hearts | Diamonds | Spades | Clubs\ntype Card = Card( c_suit : Suit, c_face : Int )\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(card_str(Card(Hearts, 12)) ++ \"\\n\")\n print!(card_str(Card(Spades, 1)) ++ \"\\n\")\n print!(card_str(Card(Clubs, 3)) ++ \"\\n\")\n print!(card_str(Card(Diamonds, 0)) ++ \"\\n\")\n return 0\n}\n\nfunc card_str(c : Card) -> String {\n match (c) {\n Card(var s, var f) -> { return face_str(f) ++ \" of \" ++ suit_str(s) }\n }\n}\n\nfunc suit_str(s : Suit) -> String {\n match (s) {\n Hearts -> { return \"Hearts\" }\n Diamonds -> { return \"Diamonds\" }\n Spades -> { return \"Spades\" }\n Clubs -> { return \"Clubs\" }\n }\n}\n\nfunc face_str(f : Int) -> String {\n match (f) {\n 1 -> { return \"Ace\" }\n 11 -> { return \"Jack\" }\n 12 -> { return \"Queen\" }\n 13 -> { return \"King\" }\n _ -> {\n if (f < 2) or (f > 10) {\n return \"INVALID\"\n } else {\n return int_to_string(f)\n }\n }\n }\n}\n\n" }, { "path": "tests/language/types/polymorphic.exp", "content": "1, 2\n1, 2\n3, 4\n3\n" }, { "path": "tests/language/types/polymorphic.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Polymorphic\n\n// Type parameters.\n\nentrypoint\nfunc main() uses IO -> Int {\n // Type checking must accept this, a, and a are the same.\n print_list!(int_to_string, foo([1, 2], [3, 4]))\n\n // Even if the full type of the second a is unknown, there's enough to\n // constrain it.\n print_list!(int_to_string, foo([1, 2], []))\n\n // They're also allowed to be the same if bar accepts a and b.\n print_list!(int_to_string, bar([1, 2], [3, 4]))\n\n // This also works when the type parameter is buried deep within a type\n // expression in the callee's declaration.\n print!(int_to_string(baz(Troz(Zort(return3)))) ++ \"\\n\")\n\n return 0\n}\n\n// Some of the same except from a polymorphic context\nfunc test2(a1 : 'a, c : 'c, a2 : 'a, la1 : List('a), la2 : List('a)) uses IO {\n // Type checking must accept this, a, and a are the same.\n _ = foo(a1, a1)\n _ = foo(a1, a2)\n _ = foo(la1, la2)\n\n // They're also allowed to be the same if bar accepts a and b.\n _ = bar(a1, a1)\n _ = bar(a1, a2)\n _ = bar(la1, la2)\n}\n\nfunc foo(a1 : 'a, a2 : 'a) -> 'a {\n return a1\n}\n\nfunc bar(a : 'a, b : 'b) -> 'b {\n return b\n}\n\nfunc return3() -> Int { return 3 }\n\ntype Troz('x) = Troz(x : 'x)\ntype Zort('x) = Zort(x : 'x)\n\nfunc baz(t : Troz(Zort(func() -> 'q))) -> 'q {\n match (t) {\n Troz(var z) -> {\n match (z) {\n Zort(var f) -> { return f() }\n }\n }\n }\n}\n\n/*-----*/\n\nfunc print_list(f : func('a) -> String, l0 : List('a)) uses IO {\n print!(join(\", \", (map(f, l0))) ++ \"\\n\")\n}\n\nfunc map(f : func('a) -> 'b, l : List('a)) -> List('b) {\n match (l) {\n [] -> { return [] }\n [var x | var xs] -> { return [f(x) | map(f, xs)] }\n }\n}\n\nfunc join(j : String, l : List(String)) -> String {\n match (l) {\n [] -> {\n return \"\"\n }\n [var x | var xs] -> {\n match (xs) {\n [] -> {\n return x\n }\n [_ | _] -> {\n return x ++ j ++ join(j, xs)\n }\n }\n }\n }\n}\n\n" }, { "path": "tests/language/types/recursive.exp", "content": "1, 2, 3\n9\n" }, { "path": "tests/language/types/recursive.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Recursive\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(list_str(MyCons(1, MyCons(2, MyCons(3, MyNil)))) ++ \"\\n\")\n print!(a_str(TermAB(TermBA(TermA(2), 2), 5)) ++ \"\\n\")\n return 0\n}\n\n// Demonstrate a recursive type\ntype MyList = MyNil | MyCons ( head : Int, tail : MyList )\n\nfunc list_str(c : MyList) -> String {\n match (c) {\n MyNil -> { return \"\" }\n MyCons(var n, var l) -> { return int_to_string(n) ++ list_str2(l) }\n }\n}\n\nfunc list_str2(c : MyList) -> String {\n match (c) {\n MyNil -> { return \"\" }\n MyCons(var n, var l) -> {\n return \", \" ++ int_to_string(n) ++ list_str2(l)\n }\n }\n}\n\n// And mutually recursive types (and functions).\ntype TermA = TermA (ai : Int)\n | TermAB (ab : TermB, abi : Int)\ntype TermB = TermBA (ba : TermA, bai : Int)\n\nfunc a_str(a : TermA) -> String {\n return int_to_string(a_int(a))\n}\n\nfunc a_int(a : TermA) -> Int {\n match (a) {\n TermA(var n) -> { return n }\n TermAB(var b, var n) -> { return b_int(b) + n }\n }\n}\n\nfunc b_int(b : TermB) -> Int {\n match(b) {\n TermBA(var a, var n) -> { return a_int(a) * n }\n }\n}\n\n" }, { "path": "tests/language/types/tagging1.exp", "content": "Diamonds\nA\n3\nA\nB\nC 4\ndee\n" }, { "path": "tests/language/types/tagging1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Tagging1\n\n// Simple enum\ntype Suit = Hearts | Diamonds | Spades | Clubs\ntype Type2 = A | B (bf : Int )\ntype Type3 = A | B | C (cf : Int) | D (df : String)\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(suit_str(Diamonds) ++ \"\\n\")\n print!(type2_str(A) ++ \"\\n\")\n print!(type2_str(B(3)) ++ \"\\n\")\n print!(type3_str(A) ++ \"\\n\")\n print!(type3_str(B) ++ \"\\n\")\n print!(type3_str(C(4)) ++ \"\\n\")\n print!(type3_str(D(\"dee\")) ++ \"\\n\")\n return 0\n}\n\nfunc suit_str(s : Suit) -> String {\n match (s) {\n Hearts -> { return \"Hearts\" }\n Diamonds -> { return \"Diamonds\" }\n Spades -> { return \"Spades\" }\n Clubs -> { return \"Clubs\" }\n }\n}\n\nfunc type2_str(x : Type2) -> String {\n match (x) {\n A -> { return \"A\" }\n B(var v) -> { return int_to_string(v) }\n }\n}\n\nfunc type3_str(x : Type3) -> String {\n match (x) {\n A -> { return \"A\" }\n B -> { return \"B\" }\n C(var n) -> { return \"C \" ++ int_to_string(n) }\n D(var s) -> { return s }\n }\n}\n\n" }, { "path": "tests/language/types/tagging2.exp", "content": "A\nB\nC 4\nD dee\nE 53\nF fFfFf\n" }, { "path": "tests/language/types/tagging2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Tagging2\n\n// Simple enum\ntype Type = A // ptag 0, value 0 \n | B // ptag 0, value 1\n | C (cf : Int) // ptag 1\n | D (df : String) // ptag 2\n | E (ef : Int) // ptag 3, stag 0\n | F (ff : String) // ptag 3, stag 1\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(type_str(A) ++ \"\\n\")\n print!(type_str(B) ++ \"\\n\")\n print!(type_str(C(4)) ++ \"\\n\")\n print!(type_str(D(\"dee\")) ++ \"\\n\")\n print!(type_str(E(53)) ++ \"\\n\")\n print!(type_str(F(\"fFfFf\")) ++ \"\\n\")\n return 0\n}\n\nfunc type_str(x : Type) -> String {\n match (x) {\n A -> { return \"A\" }\n B -> { return \"B\" }\n C(var n) -> { return \"C \" ++ int_to_string(n) }\n D(var s) -> { return \"D \" ++ s }\n E(var n) -> { return \"E \" ++ int_to_string(n) }\n F(var s) -> { return \"F \" ++ s }\n }\n}\n\n" }, { "path": "tests/language/types/types_invalid_02.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[types_invalid_02]\ntype = program\nmodules = [TypesInvalid_02]\n\n" }, { "path": "tests/language/types/types_invalid_02.exp", "content": "types_invalid_02.p:14: Wrong number of type args for 'MyList', expected: 1,\n got: 0\ntypes_invalid_02.p:16: Wrong number of type args for 'MyList', expected: 1,\n got: 2\n" }, { "path": "tests/language/types/types_invalid_02.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule TypesInvalid_02\n\nfunc main() uses IO -> Int {\n return 0\n}\n\n// List is not a concrete type.\ntype MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList )\n\nfunc list_length(l : MyList('t, 'w)) -> Int {\n match (l) {\n MyNil -> { return 0 }\n MyCons(_, var rest) -> { return 1 + list_length(rest) }\n }\n}\n\n" }, { "path": "tests/language/types/types_invalid_03.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[types_invalid_03]\ntype = program\nmodules = [TypesInvalid_03]\n\n" }, { "path": "tests/language/types/types_invalid_03.exp", "content": "types_invalid_03.p:14: Type variable 'b' does not appear on left of '=' in type\n definition\n" }, { "path": "tests/language/types/types_invalid_03.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule TypesInvalid_03\n\nfunc main() uses IO -> Int {\n return 0\n}\n\n// Type variable 'b is not on the LHS.\ntype MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('b) )\n\n" }, { "path": "tests/language/types/types_invalid_04.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[types_invalid_04]\ntype = program\nmodules = [TypesInvalid_04]\n\n" }, { "path": "tests/language/types/types_invalid_04.exp", "content": "types_invalid_04.p:13: \"MyList(string)\" and \"MyList(int)\" are not the same,\n because\n \"string\" and \"int\" are not the same\n" }, { "path": "tests/language/types/types_invalid_04.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule TypesInvalid_04\n\nfunc main() uses IO -> Int {\n var list1 = MyCons(1, MyCons(2, MyCons(3, MyCons(4, MyNil))))\n var list2 = MyCons(\"Aa\", MyCons(\"Bb\", MyCons(\"Cc\", MyNil)))\n \n print!(int_to_string(list_length(append(list1, list2))) ++ \"\\n\")\n \n return 0\n}\n\n// Demonstrate an abstract type.\ntype MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('a) )\n\nfunc list_length(l : MyList('t)) -> Int {\n match (l) {\n MyNil -> { return 0 }\n MyCons(_, var rest) -> { return 1 + list_length(rest) }\n }\n}\n\nfunc append(l1 : MyList('a), l2 : MyList('a)) -> MyList('a) {\n match (l1) {\n MyNil -> { return l2 }\n MyCons(var head, var tail) -> {\n return MyCons(head, append(tail, l2))\n }\n }\n}\n\n" }, { "path": "tests/language/types/types_invalid_05.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[types_invalid_05]\ntype = program\nmodules = [TypesInvalid_05]\n\n" }, { "path": "tests/language/types/types_invalid_05.exp", "content": "types_invalid_05.p:29: \"MyList('a)\" and \"MyList('b)\" are not the same, because\n \"'a\" and \"'b\" are not the same\n" }, { "path": "tests/language/types/types_invalid_05.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule TypesInvalid_05\n\nfunc main() uses IO -> Int {\n var list1 = MyCons(1, MyCons(2, MyCons(3, MyCons(4, MyNil))))\n var list2 = MyCons(\"Aa\", MyCons(\"B\", MyCons(\"C\", MyNil)))\n \n print!(int_to_string(list_length(append(list1, list2))) ++ \"\\n\")\n \n return 0\n}\n\n// Demonstrate an abstract type.\ntype MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('a) )\n\nfunc list_length(l : MyList('t)) -> Int {\n match (l) {\n MyNil -> { return 0 }\n MyCons(_, var rest) -> { return 1 + list_length(rest) }\n }\n}\n\n// Type error here, because a != b.\nfunc append(l1 : MyList('a), l2 : MyList('b)) -> MyList('a) {\n match (l1) {\n MyNil -> { return l2 }\n MyCons(var head, var tail) -> {\n return MyCons(head, append(tail, l2))\n }\n }\n}\n\n" }, { "path": "tests/language/types/types_invalid_06.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[types_invalid_06]\ntype = program\nmodules = [TypesInvalid_06]\n\n" }, { "path": "tests/language/types/types_invalid_06.exp", "content": "types_invalid_06.p:15: Ambigious types\n The unbound solver variables are:\n 'Sv_v_19 = MyList(_)\n 'Anon_21 = _ # ? no 1\n 'Anon_22 = _ # ? no 1\n\n The unresolved solver clauses are:\n % ../types_invalid_06.p:15\n 'Sv_v_19 = MyList('Anon_22)\n\n % ../types_invalid_06.p:15\n 'Sv_v_19 = MyList('Anon_21)\n" }, { "path": "tests/language/types/types_invalid_06.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule TypesInvalid_06\n\nfunc main() uses IO -> Int {\n var list1 = MyCons(1, MyCons(2, MyCons(3, MyCons(4, MyNil))))\n var list2 = MyCons(\"A\", MyCons(\"B\", MyCons(\"Cc\", MyNil)))\n\n // Type error here because the return type of append isn't constrained\n // enough. The typechecker should fail to find a unique solution.\n print!(int_to_string(list_length(append(list1, list2))) ++ \"\\n\")\n \n return 0\n}\n\n// Demonstrate an abstract type.\ntype MyList('a) = MyNil | MyCons ( head : 'a, tail : MyList('a) )\n\nfunc list_length(l : MyList('t)) -> Int {\n match (l) {\n MyNil -> { return 0 }\n MyCons(_, var rest) -> { return 1 + list_length(rest) }\n }\n}\n\nfunc append(l1 : MyList('a), l2 : MyList('b)) -> MyList('c) {\n return MyNil\n}\n\n" }, { "path": "tests/language/types/types_invalid_07.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[types_invalid_07]\ntype = program\nmodules = [TypesInvalid_07]\n\n" }, { "path": "tests/language/types/types_invalid_07.exp", "content": "types_invalid_07.p:10: Unknown type: INt\n" }, { "path": "tests/language/types/types_invalid_07.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule TypesInvalid_07\n\n// Check that we get an okay error message when a type is not known.\nfunc main() uses IO -> INt {\n return 0\n}\n\n" }, { "path": "tests/language/types/types_invalid_08.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[types_invalid_08]\ntype = program\nmodules = [TypesInvalid_08]\n\n" }, { "path": "tests/language/types/types_invalid_08.exp", "content": "types_invalid_08.p:15: \"Zort(func() -> int)\" and \"Zort(func() -> string)\" are\n not the same, because\n \"func() -> int\" and \"func() -> string\" are not the same,\n because\n \"int\" and \"string\" are not the same\n" }, { "path": "tests/language/types/types_invalid_08.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule TypesInvalid_08\n\n// Test type parameters.\n\nfunc main() uses IO -> Int {\n // TODO: Improve the typechecker's error handling and add tests that\n // mirror those in valid/types_8.p\n\n print!(baz(Troz(Zort(return3))) ++ \"\\n\")\n\n return 0\n}\n\nfunc return3() -> Int { return 3 } \n\ntype Troz('x) = Troz(x : 'x)\ntype Zort('x) = Zort(x : 'x)\n\nfunc baz(t : Troz(Zort(func() -> 'q))) -> 'q {\n match (t) {\n Troz(var z) -> {\n match (z) {\n Zort(var f) -> { return f() }\n }\n }\n }\n}\n\n" }, { "path": "tests/language/vars/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[vars_1]\ntype = program\nmodules = [Vars_1]\n\n[vars_2]\ntype = program\nmodules = [Vars_2]\n\n" }, { "path": "tests/language/vars/vars_1.exp", "content": "x, y: 5, 1\nz: 24\n" }, { "path": "tests/language/vars/vars_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Vars_1\n\nentrypoint\nfunc main() uses IO -> Int {\n // We can assign to _ as many times as we want.\n _ = foo(1)\n _, var x = bar(3)\n _ = foo(2)\n var y, _ = bar(4)\n\n print!(\"x, y: \" ++ int_to_string(x) ++ \", \" ++ int_to_string(y) ++ \"\\n\")\n print!(\"z: \" ++ int_to_string(baz(x, y, x+y)) ++ \"\\n\")\n\n return 0\n}\n\n// Wildcards can appear as function arguments.\nfunc foo(_ : Int) -> Int { return 3 }\n\nfunc bar(n : Int) -> (Int, Int) { return n - 3, n+2 }\n\n// Wildcards can appear multiple times as function arguments, and also in the\n// body:\nfunc baz(_ : Int, _ : Int, c : Int) -> Int {\n _ = foo(c)\n return c*4\n}\n\n" }, { "path": "tests/language/vars/vars_2.exp", "content": "Hello test 1\nTest 2: a + b is 8\ntest 3: 3 is less than 4\n" }, { "path": "tests/language/vars/vars_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Vars_2\n\nentrypoint\nfunc main() uses IO -> Int {\n test1!()\n test2!()\n test3!(3)\n\n return 0\n}\n\nfunc test1() uses IO {\n // You can introduce a variable\n var msg1\n // Then initialise it\n msg1 = \"Hello \"\n\n // Or introduce and initialise it\n var msg2 = \"test 1\"\n\n print!(msg1 ++ msg2 ++ \"\\n\")\n}\n\nfunc test2() uses IO {\n var a, var b = 3, 5\n print!(\"Test 2: a + b is \" ++ int_to_string(a + b) ++ \"\\n\")\n}\n\nfunc test3(q : Int) uses IO {\n var x\n if (q < 4) {\n x = \"less than\"\n } else {\n x = \"greater than or equal to\"\n }\n print!(\"test 3: \" ++ int_to_string(q) ++ \" is \" ++ x ++ \" 4\\n\")\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_01.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_01]\ntype = program\nmodules = [VarsInvalid_01]\n" }, { "path": "tests/language/vars/vars_invalid_01.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown symbol: y\nContext: ../vars_invalid_01.p:12\nplzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_01 \n\nexport\nfunc main() uses IO -> Int {\n var x = 3\n print!(int_to_string(y))\n return 0\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_02.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_02]\ntype = program\nmodules = [VarsInvalid_02]\n" }, { "path": "tests/language/vars/vars_invalid_02.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Two or more parameters have the same name\nContext: ../vars_invalid_02.p:10\nplzc location: predicate `pre.from_ast.ast_to_pre_body'/10\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_02.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_02\n\nexport\nfunc foo(a : Int, a : Int) -> Int {\n return a + a\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_03.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_03]\ntype = program\nmodules = [VarsInvalid_03]\n" }, { "path": "tests/language/vars/vars_invalid_03.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: The variable 'b' is already initialised\nContext: ../vars_invalid_03.p:11\nplzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_03.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_03\n\nexport\nfunc foo(a : Int, b : Int) -> Int {\n b = a * 3\n return b\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_04.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_04]\ntype = program\nmodules = [VarsInvalid_04]\n" }, { "path": "tests/language/vars/vars_invalid_04.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: The variable 'c' is already declared\nContext: ../vars_invalid_04.p:12\nplzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_04.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_04\n\nexport \nfunc foo(a : Int, b : Int) -> Int {\n var c = a + b\n var c = a * b\n return c\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_05.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_05]\ntype = program\nmodules = [VarsInvalid_05]\n" }, { "path": "tests/language/vars/vars_invalid_05.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Variable 'b' already defined\nContext: ../vars_invalid_05.p:11\nplzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_05.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_05\n\nexport \nfunc foo(a : Int, b : Int) -> Int {\n match (a) {\n 1 -> { return 1 }\n var b -> { return b*3 }\n }\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_06.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_06]\ntype = program\nmodules = [VarsInvalid_06]\n" }, { "path": "tests/language/vars/vars_invalid_06.exp", "content": "vars_invalid_06.p:14: Parse error, read ident expected\n statement or closing brace\n" }, { "path": "tests/language/vars/vars_invalid_06.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_06\n\nexport\nfunc main() uses IO -> Int {\n _ = foo(1)\n\n // It is an error to read from _.\n print!(int_to_string(_))\n\n return 0\n}\n\nfunc foo(n : Int) -> Int { return n + 3 }\n\n" }, { "path": "tests/language/vars/vars_invalid_07.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_07]\ntype = program\nmodules = [VarsInvalid_07]\n" }, { "path": "tests/language/vars/vars_invalid_07.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: The variable 'c' is already initialised\nContext: ../vars_invalid_07.p:12\nplzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_07.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_07\n\nexport\nfunc foo(a : Int, b : Int) -> Int {\n var c = a + b\n c = a * b\n return c\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_08.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_08]\ntype = program\nmodules = [VarsInvalid_08]\n" }, { "path": "tests/language/vars/vars_invalid_08.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown variable or constructor 'c'\nContext: ../vars_invalid_08.p:11\nplzc location: predicate `pre.from_ast.ast_to_pre_pattern'/8\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_08.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_08\n\nexport\nfunc foo(a : Int, b : Int) -> Int {\n c = a + b\n return c\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_09.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_09]\ntype = program\nmodules = [VarsInvalid_09]\n" }, { "path": "tests/language/vars/vars_invalid_09.exp", "content": "vars_invalid_09.p:16: This branch did not initialise variables initialised on\n other branches, they are: y, y2\n" }, { "path": "tests/language/vars/vars_invalid_09.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_09 \n\nexport\nfunc main() uses IO -> Int {\n var x = 3\n var y\n var y2\n match (x) {\n 3 -> {\n var z = 4\n }\n var yy -> {\n y = yy * 26\n y2 = y * 2\n }\n }\n\n print!(int_to_string(y + y2))\n return 0\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_10.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_10]\ntype = program\nmodules = [VarsInvalid_10]\n" }, { "path": "tests/language/vars/vars_invalid_10.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: The variable 'y' is already initialised\nContext: ../vars_invalid_10.p:19\nplzc location: predicate `pre.from_ast.pattern_simple_vars_or_wildcards'/9\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_10.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_10 \n\nexport\nfunc main() uses IO -> Int {\n var x = 3\n var y\n if (x == 4) {\n y = 2\n } else {\n var yy = \"f\"\n }\n\n y = 3\n\n print!(int_to_string(y))\n return 0\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_11.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_11]\ntype = program\nmodules = [VarsInvalid_11]\n" }, { "path": "tests/language/vars/vars_invalid_11.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown symbol: z\nContext: ../vars_invalid_11.p:22\nplzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_11.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_11\n\nexport\nfunc main() uses IO -> Int {\n var x = 3\n var y\n match (x) {\n 3 -> {\n var z = 4\n }\n var yy -> {\n y = yy * 26\n }\n }\n\n print!(int_to_string(z))\n return 0\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_12.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_12]\ntype = program\nmodules = [VarsInvalid_12]\n" }, { "path": "tests/language/vars/vars_invalid_12.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown symbol: z\nContext: ../vars_invalid_12.p:21\nplzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_12.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_12\n\nexport\nfunc main() uses IO -> Int {\n var x = 3\n match (x) {\n 3 -> {\n var z = 4\n }\n var yy -> {\n var z = yy * 26\n }\n }\n\n print!(int_to_string(z))\n return 0\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_13.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_13]\ntype = program\nmodules = [VarsInvalid_13]\n" }, { "path": "tests/language/vars/vars_invalid_13.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Variable not initalised: x\nContext: ../vars_invalid_13.p:12\nplzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_13.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_13 \n\nexport\nfunc main() uses IO -> Int {\n var x\n print!(int_to_string(x))\n return 0\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_14.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_14]\ntype = program\nmodules = [VarsInvalid_14]\n" }, { "path": "tests/language/vars/vars_invalid_14.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Variable not initalised: x\nContext: ../vars_invalid_14.p:13\nplzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nplzc file: pre.from_ast.m\n" }, { "path": "tests/language/vars/vars_invalid_14.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_14\n\nexport\nfunc main() uses IO -> Int {\n var x\n func foo() uses IO {\n print!(int_to_string(x))\n }\n return 0\n}\n\n" }, { "path": "tests/language/vars/vars_invalid_15.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[vars_invalid_15]\ntype = program\nmodules = [VarsInvalid_15]\n" }, { "path": "tests/language/vars/vars_invalid_15.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Compilation error, cannot unify types\nplzc location: predicate `core.type_chk.unify_type_or_var'/5\nplzc file: core.type_chk.m\n" }, { "path": "tests/language/vars/vars_invalid_15.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule VarsInvalid_15\n\nexport\nfunc main() uses IO -> Int {\n var x\n var y = 2\n if (3 > y) {\n x = \"Greater than\"\n } else {\n x = -1\n }\n return 0\n}\n\n" }, { "path": "tests/library/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[args]\ntype = program\nmodules = [Args]\n\n" }, { "path": "tests/library/args.exp", "content": "Unsupported, cannot execute programs that accept command line arguments. (Bug \n" }, { "path": "tests/library/args.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n *\n * PLZTEST todo runtime doesn't support command line args\n * PLZTEST output stderr\n */\n\nmodule Args \n\nentrypoint\nfunc main(args : List(String)) uses IO -> Int {\n foldl!(say_hi, args)\n\n return 0\n}\n\nfunc say_hi(name : String) uses IO {\n print!(\"Hello \" ++ name ++ \"\\n\")\n}\n\nfunc foldl(f : func('t) uses IO, l : List('t)) uses IO {\n match (l) {\n [] -> {}\n [var x | var xs] -> {\n f!(x)\n foldl!(f, xs)\n }\n }\n}\n\n" }, { "path": "tests/modules/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[entrypoint_2]\ntype = program\nmodules = [Entrypoint2a, Entrypoint2b]\n\n[entrypoint_3]\ntype = program\nmodules = [Entrypoint3a, Entrypoint3b]\n\n[module_04]\ntype = program\nmodules = [Module_04, Module_04a]\n\n[module_05]\ntype = program\nmodules = [Module_05, Module_05a]\n\n[module_06]\ntype = program\nmodules = [Module_06, Module_06a]\n\n[module_07]\ntype = program\nmodules = [Module_07, Module_07a]\n\n[res_vis_01]\ntype = program\nmodules = [ResVis01, ResVis01.A, ResVis01.B, ResVis01.C, ResVis01.D]\n\n" }, { "path": "tests/modules/Makefile", "content": "#\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# We don't normally use make to build Plasma programs, but it helps in this\n# case where we want to check some of the individual tools work when called\n# in \"different\" ways.\n#\n# vim: noet sw=4 ts=4\n#\n\nTOP=../..\n\n.PHONY: all\nall: module_03a.pzo module_03b.pzo module_03c.pzo module_08.pzo \\\n\tdyn_link_01_a.pz dyn_link_01.pz \\\n\tdyn_link_02_ab.pz dyn_link_02.pz\n\n%.pi : %.p $(TOP)/src/plzc\n\t$(TOP)/src/plzc --mode make-interface $<\n\n%.typeres : %.p $(TOP)/src/plzc\n\t$(TOP)/src/plzc --mode make-typeres-exports $<\n\n%.pzo : %.p $(TOP)/src/plzc\n\t$(TOP)/src/plzc $<\n\n%.pz : %.pzo $(TOP)/src/plzlnk\n\t$(TOP)/src/plzlnk -n ${subst .pz,,$@} -o $@ $<\n\ndyn_link_01.pzo : dyn_link_01_a.pi\ndyn_link_01_a.pz : dyn_link_01_a.pzo\n\t$(TOP)/src/plzlnk -n DynLink01A --library -o $@ \\\n\t\tdyn_link_01_a.pzo\n\ndyn_link_02.pzo : dyn_link_02_a.pi dyn_link_02_b.pi\ndyn_link_02_ab.pz : dyn_link_02_a.pzo dyn_link_02_b.pzo\n\t$(TOP)/src/plzlnk -n DynLink02A -n DynLink02B --library -o $@ \\\n\t\tdyn_link_02_a.pzo dyn_link_02_b.pzo\n\n" }, { "path": "tests/modules/dyn_link_01.exp", "content": "Hello universe!\n" }, { "path": "tests/modules/dyn_link_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule DynLink01 \n\n// The import declaration works, it causes the interface file to be read.\nimport DynLink01A as A \n\nentrypoint\nfunc main() uses IO -> Int {\n // The calls to the imported functions work.\n A.printMessage!(\"Hello \" ++ A.getMessage())\n\n return 0\n}\n\n" }, { "path": "tests/modules/dyn_link_01.sh", "content": "#!/bin/sh\n\nTOP=../..\n\n$TOP/runtime/plzrun -l dyn_link_01_a.pz dyn_link_01.pz\n\n" }, { "path": "tests/modules/dyn_link_01_a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule DynLink01A\n\nexport\nfunc getMessage() -> String {\n return \"universe!\"\n}\n\nexport\nfunc printMessage(message : String) uses IO {\n print!(message ++ \"\\n\")\n}\n\n" }, { "path": "tests/modules/dyn_link_02.exp", "content": "Hello universe!\n" }, { "path": "tests/modules/dyn_link_02.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule DynLink02 \n\nimport DynLink02A as A \nimport DynLink02B as B\n\nentrypoint\nfunc main() uses IO -> Int {\n A.printMessage!(\"Hello \" ++ B.getMessage())\n\n return 0\n}\n\n" }, { "path": "tests/modules/dyn_link_02.sh", "content": "#!/bin/sh\n\nTOP=../..\n\n$TOP/runtime/plzrun -l dyn_link_02_ab.pz dyn_link_02.pz\n\n" }, { "path": "tests/modules/dyn_link_02_a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule DynLink02A \n\nexport\nfunc printMessage(message : String) uses IO {\n print!(message ++ \"\\n\")\n}\n\n" }, { "path": "tests/modules/dyn_link_02_b.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule DynLink02B \n\nexport\nfunc getMessage() -> String {\n return \"universe!\"\n}\n\n" }, { "path": "tests/modules/entrypoint_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[Entrypoint_1]\ntype = program\nmodules = [Entrypoint1a, Entrypoint1b]\n\n" }, { "path": "tests/modules/entrypoint_1.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown symbol: T1a.test1a\nContext: ../entrypoint_1b.p:14\nplzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nplzc file: pre.from_ast.m\n" }, { "path": "tests/modules/entrypoint_1a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Entrypoint1a\n\n// Function is not exported.\nentrypoint\nfunc test1a() uses IO -> Int {\n print!(\"Test 1\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/modules/entrypoint_1b.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Entrypoint1b\n\nimport Entrypoint1a as T1a\n\nfunc test1b() uses IO -> Int {\n // Call should fail because although test2a is an entrypoin it is not\n // exported.\n return T1a.test1a!()\n}\n\n" }, { "path": "tests/modules/entrypoint_2.exp", "content": "Test 2\n" }, { "path": "tests/modules/entrypoint_2a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Entrypoint2a\n\nexport entrypoint\nfunc test2a() uses IO -> Int {\n print!(\"Test 2\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/modules/entrypoint_2b.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Entrypoint2b\n\nimport Entrypoint2a as T2a\n\nfunc test2b() uses IO -> Int {\n return T2a.test2a!()\n}\n\n" }, { "path": "tests/modules/entrypoint_3.exp", "content": "Test 3\n" }, { "path": "tests/modules/entrypoint_3a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Entrypoint3a\n\n// entrypoint2 has the keywords in the opposite order.\nentrypoint export\nfunc test3a() uses IO -> Int {\n print!(\"Test 3\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/modules/entrypoint_3b.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Entrypoint3b\n\nimport Entrypoint3a as T3a\n\nfunc test3b() uses IO -> Int {\n return T3a.test3a!()\n}\n\n" }, { "path": "tests/modules/heir.foo.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Heir.Foo\n\nexport\nfunc test1() uses IO {\n print!(\"Test1\\n\")\n}\n\n" }, { "path": "tests/modules/heir.foo_bar.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Heir.Foo.Bar\n\nexport\nfunc test() uses IO {\n print!(\"Test from bar\\n\")\n}\n\n" }, { "path": "tests/modules/heir_test.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[heir_test]\ntype = program\nmodules = [HeirTest, Heir.Foo, Heir.Foo.Bar]\n\n" }, { "path": "tests/modules/heir_test.exp", "content": "Test1\nTest from bar\nTest1\nTest1\n" }, { "path": "tests/modules/heir_test.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule HeirTest\n\n// Test modules that are organised in a heirachy. Also test importing them\n// _to_ different names and multiple times.\nimport Heir.Foo\nimport Heir.Foo as Foo\nimport Heir.Foo as F\nimport Heir.Foo.Bar\n\nentrypoint\nfunc main() uses IO -> Int {\n Heir.Foo.test1!()\n Heir.Foo.Bar.test!()\n Foo.test1!()\n F.test1!()\n\n return 0\n}\n\n" }, { "path": "tests/modules/module_01.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[module_01]\ntype = program\nmodules = [Module_01, Module_01a]\n\n" }, { "path": "tests/modules/module_01.exp", "content": "Hello universe!\n" }, { "path": "tests/modules/module_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_01\n\n// The import declaration works, it causes the interface file to be read.\nimport Module_01a\n\nentrypoint\nfunc main() uses IO -> Int {\n // The calls to the imported functions work.\n Module_01a.printMessage!(\"Hello \" ++ Module_01a.getMessage())\n\n return 0\n}\n\n" }, { "path": "tests/modules/module_01a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_01a\n\nexport\nfunc getMessage() -> String {\n return \"universe!\"\n}\n\nexport\nfunc printMessage(message : String) uses IO {\n print!(message ++ \"\\n\")\n}\n\n" }, { "path": "tests/modules/module_02.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[module_02]\ntype = program\nmodules = [Module_02, Module_02a]\n\n" }, { "path": "tests/modules/module_02.exp", "content": "is_odd(0) = False\nis_odd(1) = True\nis_odd(2) = False\nis_odd(34) = False\nis_odd(35) = True\n" }, { "path": "tests/modules/module_02.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_02\n\n// The import declaration works, it causes the interface file to be read.\nimport Module_02a\n\nexport\nfunc is_odd(n : Int) -> Bool {\n if (n == 0) {\n return False\n } else {\n return Module_02a.is_even(n - 1)\n }\n}\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"is_odd(0) = \" ++ bool_to_string(is_odd(0)) ++ \"\\n\")\n print!(\"is_odd(1) = \" ++ bool_to_string(is_odd(1)) ++ \"\\n\")\n print!(\"is_odd(2) = \" ++ bool_to_string(is_odd(2)) ++ \"\\n\")\n print!(\"is_odd(34) = \" ++ bool_to_string(is_odd(34)) ++ \"\\n\")\n print!(\"is_odd(35) = \" ++ bool_to_string(is_odd(35)) ++ \"\\n\")\n return 0\n}\n\n" }, { "path": "tests/modules/module_02a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_02a\n\nimport Module_02\n\nexport\nfunc is_even(n : Int) -> Bool {\n if (n == 0) {\n return True\n } else {\n return Module_02.is_odd(n - 1)\n }\n}\n\n\n" }, { "path": "tests/modules/module_03a.exp", "content": "This is Module_03a\n" }, { "path": "tests/modules/module_03a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_03a\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"This is Module_03a\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/modules/module_03a.sh", "content": "#!/bin/sh\n\nTOP=../..\n\n# Link two modules, both with entry points and check that we get the correct\n# one.\n#\n# Test b chooses the \"other\" entrypoint,\n# Test ar and br link the modules in the reverse order.\n# Test c links only one module with an entry point and checks that it is\n# selected implicity. \n\n$TOP/src/plzlnk -n Module_03a -e Module_03a.main -o module_03a.pz \\\n module_03a.pzo module_03b.pzo\n$TOP/runtime/plzrun module_03a.pz\n\n" }, { "path": "tests/modules/module_03ar.exp", "content": "This is Module_03a\n" }, { "path": "tests/modules/module_03ar.sh", "content": "#!/bin/sh\n\nTOP=../..\n\n$TOP/src/plzlnk -n Module_03a -e Module_03a.main -o module_03a.pz \\\n module_03b.pzo module_03a.pzo\n$TOP/runtime/plzrun module_03a.pz\n\n" }, { "path": "tests/modules/module_03b.exp", "content": "This is Module_03b\n" }, { "path": "tests/modules/module_03b.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_03b\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"This is Module_03b\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/modules/module_03b.sh", "content": "#!/bin/sh\n\nTOP=../..\n\n$TOP/src/plzlnk -n Module_03b -e Module_03b.main -o module_03b.pz \\\n module_03a.pzo module_03b.pzo\n$TOP/runtime/plzrun module_03b.pz\n\n" }, { "path": "tests/modules/module_03br.exp", "content": "This is Module_03b\n" }, { "path": "tests/modules/module_03br.sh", "content": "#!/bin/sh\n\nTOP=../..\n\n$TOP/src/plzlnk -n Module_03b -e Module_03b.main -o module_03b.pz \\\n module_03b.pzo module_03a.pzo\n$TOP/runtime/plzrun module_03b.pz\n\n" }, { "path": "tests/modules/module_03c.exp", "content": "This is Module_03a\n" }, { "path": "tests/modules/module_03c.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_03c\n\nexport\nfunc main() uses IO -> Int {\n print!(\"This is Module_03c. But not an entrypoint!\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/modules/module_03c.sh", "content": "#!/bin/sh\n\nTOP=../..\n\n$TOP/src/plzlnk -n Module_03c -o module_03c.pz \\\n module_03a.pzo module_03c.pzo\n$TOP/runtime/plzrun module_03c.pz\n\n" }, { "path": "tests/modules/module_03cr.exp", "content": "This is Module_03a\n" }, { "path": "tests/modules/module_03cr.sh", "content": "#!/bin/sh\n\nTOP=../..\n\n$TOP/src/plzlnk -n Module_03c -o module_03c.pz \\\n module_03a.pzo module_03c.pzo\n$TOP/runtime/plzrun module_03c.pz\n\n" }, { "path": "tests/modules/module_04.exp", "content": "Your card is the Ace of Spades\nStr is Boo!\n" }, { "path": "tests/modules/module_04.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_04\n\n// The import declaration works, it causes the interface file to be read.\nimport Module_04a\n\nentrypoint\nfunc main() uses IO -> Int {\n test1!()\n\n Module_04a.Pair(var s, _) = test2!()\n print!(\"Str is \" ++ s ++ \"\\n\")\n\n return 0\n}\n\nfunc test1() uses IO {\n // Test that we can use constructors from types defined in another\n // module.\n var c = Module_04a.Card(Module_04a.Spade, Module_04a.Ace)\n print!(\"Your card is the \" ++ Module_04a.card_str(c) ++ \"\\n\")\n}\n\n// Test that we can reference types defined in another module, and the types\n// may be polymorphic.\nfunc test2() uses IO -> Module_04a.Pair(String, Int) {\n return Module_04a.Pair(\"Boo!\", 28)\n}\n\n" }, { "path": "tests/modules/module_04a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_04a\n\nexport\ntype Suit = Diamond\n | Heart\n | Spade\n | Club\n\nexport\ntype CardNum = Ace\n | Num ( num : Int )\n | Jack\n | Queen\n | King\n\nexport\ntype Card = Card(suit : Suit, num : CardNum)\n\nexport\ntype Pair('a, 'b) = Pair(pa : 'a, pb : 'b)\n\nexport\nfunc card_str(c : Card) -> String {\n Card(var s, var n) = c\n\n var num_str = match (n) {\n Ace -> \"Ace\"\n Num(var no) -> int_to_string(no)\n Jack -> \"Jack\"\n Queen -> \"Queen\"\n King -> \"King\"\n }\n\n var suit_str = match (s) {\n Diamond -> \"Diamonds\"\n Heart -> \"Hearts\" \n Spade -> \"Spades\"\n Club -> \"Clubs\"\n }\n\n return num_str ++ \" of \" ++ suit_str\n}\n\n" }, { "path": "tests/modules/module_05.exp", "content": "Hello\n" }, { "path": "tests/modules/module_05.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_05\n\nimport Module_05a\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"Hello\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/modules/module_05a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_05a\n\n// Type references form a cycle.\n\nexport\ntype Foo = Foo ( a : Bar )\n\nexport\ntype Bar = Bar ( b : Foo ) \n\n" }, { "path": "tests/modules/module_06.exp", "content": "zort\n" }, { "path": "tests/modules/module_06.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_06\n\nimport Module_06a\n\nentrypoint\nfunc main() uses IO -> Int {\n var s = test1!()\n print!(s ++ \"\\n\")\n return 0\n}\n\nfunc test1() uses Module_06a.Foo -> String {\n Module_06a.troz!()\n return zort!()\n}\n\nresource Zort from Module_06a.Bar\n\nfunc zort() uses Zort -> String {\n return \"zort\"\n}\n\n" }, { "path": "tests/modules/module_06a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_06a\n\n// export resources\n\nexport\nresource Foo from IO\n\nexport\nresource Bar from Foo\n\nresource Baz from Foo\n\nexport\nfunc troz() uses Bar {\n}\n\n" }, { "path": "tests/modules/module_07.exp", "content": "foo is: Foo(84)\n" }, { "path": "tests/modules/module_07.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_07\n\nimport Module_07a\n\nentrypoint\nfunc main() uses IO -> Int {\n var f = Module_07a.makeFoo(28)\n print!(\"foo is: \" ++ Module_07a.fooStr(f) ++ \"\\n\")\n\n return 0\n}\n\n" }, { "path": "tests/modules/module_07a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_07a\n\nexport opaque\ntype Foo = Foo ( a : Int )\n\nexport\nfunc makeFoo(n : Int) -> Foo {\n return Foo(n*3)\n}\n\nexport\nfunc fooStr(f : Foo) -> String {\n Foo(var n) = f\n return \"Foo(\" ++ int_to_string(n) ++ \")\"\n}\n\n" }, { "path": "tests/modules/module_08.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_08\n\n/*\n * Test that we can set this as the entrypoint on the linker command line\n */\n\nentrypoint\nfunc name1() uses IO -> Int {\n print!(\"Hello world 1\\n\") \n return 0\n}\n\nentrypoint\nfunc name2() uses IO -> Int {\n print!(\"Hello world 2\\n\") \n return 0\n}\n\n" }, { "path": "tests/modules/module_08a.exp", "content": "Hello world 1\n" }, { "path": "tests/modules/module_08a.sh", "content": "#/bin/sh\n\nTOP=../..\n\n$TOP/src/plzlnk -n Module_08a -e Module_08.name1 -o module_08a.pz \\\n module_08.pzo\n$TOP/runtime/plzrun module_08a.pz\n\n" }, { "path": "tests/modules/module_08b.exp", "content": "Hello world 2\n" }, { "path": "tests/modules/module_08b.sh", "content": "#/bin/sh\n\nTOP=../..\n\n$TOP/src/plzlnk -n Module_08a -e Module_08.name2 -o module_08b.pz \\\n module_08.pzo\n$TOP/runtime/plzrun module_08b.pz\n\n" }, { "path": "tests/modules/module_name_test.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[module_name_test]\ntype = program\nmodules = [ModuleNameTest]\n\n" }, { "path": "tests/modules/module_name_test.exp", "content": "module_name_test.p:8: The module name from the source file\n 'ModuleNameTestQUACK' does not match the module name from\n the BUILD.plz file 'ModuleNameTest'\nmodule_name_test.p:8: The source filename 'module_name_test.p' does not match\n the module name 'ModuleNameTestQUACK'\nmodule_name_test.p:8: The output filename 'ModuleNameTest.dep' does not match\n the module name 'ModuleNameTestQUACK'\n" }, { "path": "tests/modules/module_name_test.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n// This module name wont match the file name.\nmodule ModuleNameTestQUACK \n\n" }, { "path": "tests/modules/opaque_resource.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule OpaqueResource\n\nexport\nresource Res1 from IO\n\nexport opaque\nresource Res2 from Res1 \n\nexport\nfunc do_with_res(f : func('t1) uses Res2 -> 't2, x : 't1) uses Res1 -> 't2 {\n return f!(x)\n}\n\n" }, { "path": "tests/modules/opaque_resource_1.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[opaque_resource_1]\ntype = program\nmodules = [OpaqueResource1, OpaqueResource]\n\n" }, { "path": "tests/modules/opaque_resource_1.exp", "content": "Hi Bob.\n" }, { "path": "tests/modules/opaque_resource_1.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule OpaqueResource1\n\nimport OpaqueResource as OR\n\nentrypoint\nfunc test() uses IO -> Int {\n var s = test2!(\"Bob\")\n print!(s ++ \"\\n\")\n\n return 0\n}\n\nfunc test2(s : String) uses OR.Res1 -> String {\n // The only way to get Res2 is by calling into the module that can\n // access it.\n return OR.do_with_res!(test3, s)\n}\n\nfunc test3(s : String) uses OR.Res2 -> String {\n return \"Hi \" ++ s ++ \".\"\n}\n\n" }, { "path": "tests/modules/opaque_resource_2.build", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n# PLZTEST type compile_failure \n\n[opaque_resource_2]\ntype = program\nmodules = [OpaqueResource2, OpaqueResource]\n\n" }, { "path": "tests/modules/opaque_resource_2.exp", "content": "opaque_resource_2.p:22: One or more resources needed for this call is\n unavailable in this function\n" }, { "path": "tests/modules/opaque_resource_2.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule OpaqueResource2\n\nimport OpaqueResource as OR\n\nentrypoint\nfunc test() uses IO -> Int {\n var s = test2!(\"Bob\")\n print!(s ++ \"\\n\")\n\n return 0\n}\n\nfunc test2(s : String) uses OR.Res1 -> String {\n // Calling test3 directly is illegal. although Res2 comes from Res1 this\n // module doesn't know that because Res2 is opaque.\n return test3!(s)\n}\n\nfunc test3(s : String) uses OR.Res2 -> String {\n return \"Hi \" ++ s ++ \".\"\n}\n\n" }, { "path": "tests/modules/res_vis_01.a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ResVis01.A\n\nimport ResVis01.B as B\n\nexport\nresource Res1 from IO\nexport\nresource Res3 from B.Res2\n\nexport\ntype TypeA1 = StructA1 ( n : Int )\nexport\ntype TypeA3 = StructA3 ( t2 : B.TypeA2 )\n\nexport\ntype TypeB1('t) = StructB1 ( n : 't )\nexport\ntype TypeB3('t) = StructB3 ( t2 : B.TypeB2('t) )\n" }, { "path": "tests/modules/res_vis_01.b.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ResVis01.B\n\nimport ResVis01.A as A\n\nexport\nresource Res2 from A.Res1\nexport\nresource Res4 from A.Res3\n\nexport\ntype TypeA2 = StructA2 ( t1 : A.TypeA1 )\nexport\ntype TypeA4 = StructA4 ( t3 : A.TypeA3 )\n\nexport\ntype TypeB2('t) = StructB2 ( t1 : A.TypeB1('t) )\nexport\ntype TypeB4('t) = StructB4 ( t3 : A.TypeB3('t) )\n\n" }, { "path": "tests/modules/res_vis_01.c.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ResVis01.C\n\nimport ResVis01.D as D\n\nexport\nresource Res1 from IO\nexport\nresource Res3 from D.Res2\n\nexport\nfunc test(f : func() uses Res3) uses Res1 {\n f!()\n}\n\n// Show that we can export a function that depends on another module's\n// resource, which also isn't visible to ResVis01.\nexport\nfunc test2() uses D.Res2 {\n}\n// Same, but Res4 doesn't get implicitly created by this module's own\n// resources (different path in the compiler).\nexport\nfunc test3() uses D.Res4 {\n}\n\nexport\ntype TypeA1 = StructA1 ( n : Int )\nexport\ntype TypeA3 = StructA3 ( t2 : D.TypeA2 )\n\nexport\nfunc makeDA2(v : TypeA1) -> D.TypeA2 {\n return D.StructA2(v)\n}\n\nexport\ntype TypeB1('t) = StructB1 ( n : 't )\nexport\ntype TypeB3('t) = StructB3 ( t3 : D.TypeB2('t) )\n\nexport\nfunc makeDB2(v : TypeB1('t)) -> D.TypeB2('t) {\n return D.StructB2(v)\n}\n\n// Also test that referring to a type in a function but not another type\n// works.\nexport\nfunc referToDType(v1 : D.TypeA4, v2 : D.TypeB4('t)) -> String {\n return \"Hello\"\n}\n\n" }, { "path": "tests/modules/res_vis_01.d.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ResVis01.D\n\nimport ResVis01.C as C\n\nexport\nresource Res2 from C.Res1\nexport\nresource Res4 from C.Res3\n\nexport\ntype TypeA2 = StructA2 ( t2 : C.TypeA1 )\nexport\ntype TypeA4 = StructA4 ( t4 : C.TypeA3 )\n\nexport\ntype TypeB2('t) = StructB2 ( t2 : C.TypeB1('t) )\nexport\ntype TypeB4('t) = StructB4 ( t4 : C.TypeB3('t) )\n\n" }, { "path": "tests/modules/res_vis_01.exp", "content": "Test!\nThe meaning of life: 42\n" }, { "path": "tests/modules/res_vis_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule ResVis01\n\nimport ResVis01.B as B\n\n// Remove this once we make transitive resource names available.\nimport ResVis01.A as A\n\nentrypoint\nfunc main() uses IO -> Int {\n print!(\"Test!\\n\")\n \n var r = do2!() \n print!(\"The meaning of life: \" ++ int_to_string(r) ++ \"\\n\")\n \n return 0\n}\n\nfunc do2() uses B.Res2 -> Int {\n return do4!() * 2\n}\n\nfunc do4() uses B.Res4 -> Int {\n return 21\n}\n\nfunc testType1() -> A.TypeA1 {\n return A.StructA1(23) \n}\n\nfunc testTypeA4() -> B.TypeA4 {\n return B.StructA4(A.StructA3(B.StructA2(testType1())))\n}\n\nfunc testTypeB4() -> B.TypeB4(Int) {\n return B.StructB4(A.StructB3(B.StructB2(A.StructB1(555))))\n}\n\n\n// Import C but not D, show that we can use both C's resources, even the\n// one that depends on D.\nimport ResVis01.C as C\n\nfunc testCallsCRes3() uses IO {\n C.test!(testUsesCRes3)\n}\n\n// We can't convert into this resource because we can't see Res2 without\n// another import.\nfunc testUsesCRes3() uses C.Res3 {\n}\n\nfunc testUsesCTypesA() -> C.TypeA3 {\n return C.StructA3(C.makeDA2(C.StructA1(3)))\n}\n\nfunc testUsesCTypesBStr() -> C.TypeB3(String) {\n return C.StructB3(C.makeDB2(C.StructB1(\"Hello\")))\n}\n\nfunc testUsesCTypesBAbs(v : 't) -> C.TypeB3('t) {\n return C.StructB3(C.makeDB2(C.StructB1(v)))\n}\n\n" }, { "path": "tests/pretty.lua", "content": "#!/usr/bin/env lua5.3\n--\n-- Pretty test output\n--\n-- This is free and unencumbered software released into the public domain.\n-- See ../LICENSE.unlicense\n--\n\n\n-- Print without newline, for the test \"dots\"\nfunction printn(str) \n io.write(str)\n io.flush()\nend\n\n\n-- TODO: Replace with ncurses.\nlocal get_term_escape_failed = false\nfunction getTermEscape(command)\n if get_term_escape_failed then\n return nil\n end\n local pipe = io.popen(\"tput \"..command)\n if not pipe then\n get_term_escape_failed = true\n return nil\n end\n local result = pipe:read(\"*a\")\n pipe:close()\n return result\nend\n\nlocal term_bold = getTermEscape(\"bold\")\nlocal term_green = getTermEscape(\"setaf 2\")\nlocal term_red = getTermEscape(\"setaf 1\")\nlocal term_yellow = getTermEscape(\"setaf 3\")\nlocal term_cyan = getTermEscape(\"setaf 6\")\nlocal term_reset = getTermEscape(\"sgr0\")\n-- If one of these was unsuccesful then we set the terminal escape strings\n-- to empty strings and they'll have no effect.\nlocal term_success = \"\"\nlocal term_failure = \"\"\nlocal term_skip = \"\"\nlocal term_todo = \"\"\nif term_bold and term_green and term_red and term_reset then\n term_success = term_green .. term_bold\n term_failure = term_red .. term_bold\n term_skip = term_yellow .. term_bold\n term_todo = term_cyan .. term_bold\nend\nterm_reset = term_reset or \"\"\n\nlocal num_tests\nlocal num_ok = 0\nlocal num_fail = 0\nlocal num_skip = 0\nlocal num_todo = 0\nlocal num_todo_ok = 0\nlocal failed_tests = {}\nlocal todo_ok_tests = {}\n\nlocal line\nfor line in io.lines() do\n if not num_tests then\n local parse = line:match(\"^1..(%d+)\")\n if parse then\n num_tests = tonumber(parse)\n end\n end\n\n local parse_skip = line:match(\"# [sS][kK][iI][pP]\")\n local parse_todo = line:match(\"# [tT][oO][dD][oO]\")\n\n local parse_ok = line:match(\"^ok\")\n if parse_ok then\n if parse_skip then\n num_skip = num_skip + 1\n printn(term_skip .. \"-\")\n else\n if parse_todo then\n num_todo_ok = num_todo_ok + 1\n printn(term_success .. \"?\")\n table.insert(todo_ok_tests, line) \n else\n num_ok = num_ok + 1\n printn(term_success .. \".\")\n end\n end\n else\n local parse_nok = line:match(\"^not ok\")\n if parse_nok then\n if parse_skip then\n num_skip = num_skip + 1\n printn(term_skip .. \"-\")\n elseif parse_todo then\n num_todo = num_todo + 1\n printn(term_todo .. \"=\")\n else\n num_fail = num_fail + 1\n printn(term_failure .. \"+\")\n table.insert(failed_tests, line) \n end\n end\n end\nend\n\n-- print a newline\nprint(term_reset)\n\nif num_ok + num_fail + num_skip + num_todo + num_todo_ok ~= num_tests then\n print(\"Missing / extra tests: \"..num_ok..\" (pass) + \"..num_fail..\" (fail) + \"..num_skip..\" (skip) + \"..num_todo..\" (todo) + \"..num_todo_ok..\" (todo ok) = \"..num_tests)\n os.exit(1)\nend\n\nprintn(num_ok + num_todo_ok .. \" / \"..num_tests..\" tests passed\")\n\nif num_fail ~= 0 or num_skip ~= 0 or num_todo ~= 0 then\n printn(\" (\")\n if num_fail ~= 0 then\n printn(term_failure..num_fail..\" failed\"..term_reset)\n if num_skip ~= 0 or num_todo ~= 0 then\n printn(\", \")\n end\n end\n if num_todo ~= 0 then\n printn(term_todo..num_todo..\" todo\"..term_reset)\n if num_skip ~= 0 then\n printn(\", \")\n end\n end\n if num_skip ~= 0 then\n printn(term_skip..num_skip..\" skipped\"..term_reset)\n end\n \n printn(\")\")\nend\n\nprint(\"\")\n\nif num_fail ~= 0 then\n print(\"Failed tests:\")\n for _, failed in pairs(failed_tests) do\n print(\" \"..failed)\n end\nend\n\nif num_todo_ok ~= 0 then\n print(\"Some TODO tests are now passing:\")\n for _, todo_ok in pairs(todo_ok_tests) do\n print(\" \"..todo_ok)\n end\nend\n\nif num_fail ~= 0 then\n os.exit(1)\nend\n\n" }, { "path": "tests/run-tests.lua", "content": "#!/usr/bin/env lua5.3\n--\n-- Plasma testing script\n--\n-- This command expects to be passed directories in which it can find Plasma\n-- tests. Information about how it finds tests can be found in README.md.\n-- It uses the TAP protocol (http://testanything.org/tap-specification.html)\n-- so that its output may be further processed by other tools including CI.\n--\n-- This is free and unencumbered software released into the public domain.\n-- See ../LICENSE.unlicense\n--\n\n-- XXX: I couldn't make strict work, it caught errors, but execution just\n-- seemed to stop within dir_recursive()\n--\n-- local _ENV = require 'std.strict'(_G)\n\nlocal lfs = require \"lfs\"\n\n\n--\n-- Constants\n-------------\n\nlocal root_dir = lfs.currentdir()\nlocal plzbuild_bin = root_dir .. \"/src/plzbuild\"\nlocal plzrun_bin = root_dir .. \"/runtime/plzrun\"\nlocal build_type = os.getenv(\"BUILD_TYPE\")\nlocal logging = os.getenv(\"LOGGING\")\n\n\n--\n-- Utility functions\n---------------------\n\nfunction debug(message)\n -- print(message)\nend\n\nfunction log(message)\n if logging then\n print(message)\n end\nend\n\nfunction list_append(l1, l2)\n local l = {}\n for _, v in ipairs(l1) do\n table.insert(l, v)\n end\n for _, v in ipairs(l2) do\n table.insert(l, v)\n end\n return l\nend\n\nfunction all(t, f)\n for _, v in ipairs(t) do\n if not f(v) then\n return false\n end\n end\n return true\nend\n\nfunction string_split(str)\n local l = {}\n for token in str:gmatch(\"%S+\") do\n table.insert(l, token)\n end\n return l\nend\n\nfunction list_string(l)\n local s = \"\"\n for _, i in ipairs(l) do\n if (s ~= \"\") then\n s = s .. \" \"\n end\n s = s .. i\n end\n return s\nend\n\nfunction file_exists(path)\n return lfs.attributes(path) and path or nil\nend\n\n-- Return an iterator that produces all the files under dirs (an array)\n-- recursively.\nfunction dir_recursive(dirs)\n function is_dir(path)\n return path:sub(-1) == \"/\" or lfs.attributes(path, \"mode\") == \"directory\"\n end\n\n -- A recursive function generates file names\n function list_dir(dir)\n for file in lfs.dir(dir) do\n if (file ~= \".\" and file ~= \"..\") then\n local full_name = string.format(\"%s/%s\", dir, file)\n if is_dir(full_name) then\n list_dir(full_name)\n else\n coroutine.yield({dir=dir, file=file})\n end\n end\n end\n end\n\n return coroutine.wrap(function()\n for _, dir in ipairs(dirs) do\n list_dir(dir)\n end\n end)\nend\n\n-- Execute a command and capture the result code.\n--\n-- Args:\n-- dir: the working directory\n-- bin: the binary to call\n-- args: the arguments\n-- mb_input_file: a file name for input, or nil to not redirect input.\n-- mb_output_file: a file name for output, or nil to return output as a\n-- string.\n-- mb_stderr_file: a file name for stderr, or nil to return stderr as a\n-- string.\n--\n-- Returns\n-- \"exited\"/\"killed\": Did the process terminate itself, or was it killed.\n-- Number: The return code / signal number\n-- String: The output, if mb_output_file was nil.\n-- String: The stderr, if mb_stderr_file was nil.\n--\n-- A lot of this could be accomplished with popen, however I have a later\n-- refinement that I actually want the process control features I can use\n-- here.\nfunction execute(dir, bin, args, mb_input_file, mb_output_file, mb_stderr_file)\n local E = require 'posix.errno'\n local U = require 'posix.unistd'\n local W = require 'posix.sys.wait'\n local F = require 'posix.fcntl'\n local S = require 'posix.stdio'\n local P = require 'posix.sys.stat'\n\n -- Before doing any \"work\" (creating pipes and opening files) remove any\n -- stale files so that a failure doesn't leave a previous output file in\n -- place.\n if mb_output_file and lfs.attributes(mb_output_file) then\n assert(os.remove(mb_output_file))\n end\n if mb_stderr_file and lfs.attributes(mb_stderr_file) then\n assert(os.remove(mb_stderr_file))\n end\n\n local mb_output_pipe_read, mb_output_pipe_write\n if (not mb_output_file) then\n mb_output_pipe_read, mb_output_pipe_write = assert(U.pipe())\n end\n\n local mb_stderr_pipe_read, mb_stderr_pipe_write\n if (not mb_stderr_file) then\n mb_stderr_pipe_read, mb_stderr_pipe_write = assert(U.pipe())\n end\n\n local child = assert(U.fork())\n if child == 0 then\n -- We are the child.\n lfs.chdir(dir)\n\n -- Remap our side side of the pipes\n function remap(from, to)\n U.close(to)\n U.dup2(from, to)\n U.close(from)\n end\n\n -- Remap input first, in case there's an error we can complain with\n -- stdout.\n if (mb_input_file) then\n remap(assert(F.open(mb_input_file, F.O_RDONLY), 0))\n end\n local open_opts = F.O_WRONLY | F.O_TRUNC | F.O_CREAT\n local open_mode = P.S_IRUSR | P.S_IWUSR | P.S_IRGRP | P.S_IWGRP |\n P.S_IROTH | P.S_IWOTH\n if (mb_output_file) then\n remap(assert(F.open(mb_output_file, open_opts, open_mode)), 1)\n else\n U.close(mb_output_pipe_read)\n remap(mb_output_pipe_write, 1)\n end\n if (mb_stderr_file) then\n remap(assert(F.open(mb_stderr_file, open_opts, open_mode)), 2)\n else\n U.close(mb_stderr_pipe_read)\n remap(mb_stderr_pipe_write, 2)\n end\n\n local _, err = U.execp(bin, args)\n print(\"Exec of %s failed: %s\", bin, err)\n print(\"Bail out!\")\n os.exit(1)\n end\n\n log(string.format(\"Running: %s %s\", bin, list_string(args)))\n function read_stream(stream)\n local output = \"\"\n repeat\n local str = U.read(stream, 4096)\n if str then\n str = string.gsub(str, \"%s*$\", \"\")\n if str ~= \"\" then\n log(str)\n output = output .. str\n end\n end\n until not str or str == \"\"\n return output\n end\n local output = \"\"\n if mb_output_pipe_read then\n U.close(mb_output_pipe_write)\n output = read_stream(mb_output_pipe_read)\n end\n\n -- This is a bad way to read two streams since we could deadlock\n -- TODO: make them non-blocking.\n local stderr = \"\"\n if mb_stderr_pipe_read then\n U.close(mb_stderr_pipe_write)\n stderr = read_stream(mb_stderr_pipe_read)\n end\n\n local pid, exit, status\n repeat\n pid, exit, status = W.wait(child, 0)\n if pid == nil then\n debug(\"wait: \" .. exit)\n exit_error('wait')\n end\n debug(string.format(\"child: %d exit: %s status: %d\", pid, exit, status))\n until (pid == child) and (exit == \"exited\" or exit == \"killed\")\n\n -- TODO: if killed by SIGINT we should abort the whole test suite.\n return exit, status, output, stderr\nend\n\n\n--\n-- Gather all the tests\n------------------------\n\n-- Gather test configuration for this test.\n--\n-- Parameters:\n-- path - the path to the test's .exp file\n--\n-- Returns:\n-- A table containing the keys:\n-- expect_return - the test's expected return code\n-- check_stderr - if we should check stderr output rather than stdout\n-- build_type - The build type to enable this test for (nil for all)\n-- test_type - The type of this test (nil for auto or compile_failure)\n-- is_todo - This test represents an unimplemented feature\n-- build_args - The arguments for the plzbuild command\n--\nfunction test_configuration(filename)\n local expect_return = 0\n local check_stderr = false\n local build_type\n local test_type\n local is_todo = false\n local build_args\n\n function invalid_value(key, value)\n print(string.format(\"%s: Invalid value '%s' for key %s\",\n filename, value, key))\n end\n\n local file = io.open(filename)\n if file then\n -- File exists, we can parse it for test declarations.\n local line_no = 0\n for line in file:lines() do\n line_no = line_no + 1\n local _, _, key, value = string.find(line, \"PLZTEST%s+(%S+)%s+(.-)%s*$\")\n if key then\n if key == \"returns\" then\n expect_return = tonumber(value)\n if not expect_return then\n invalid_value(line_no, key, value)\n end\n elseif key == \"output\" then\n if value == \"stdout\" then\n check_stderr = false\n elseif value == \"stderr\" then\n check_stderr = true\n else\n invalid_value(line_no, key, value)\n end\n elseif key == \"build_type\" then\n build_type = value \n elseif key == \"type\" then\n test_type = value\n elseif key == \"build_args\" then\n build_args = string_split(value)\n elseif key == \"todo\" then\n is_todo = value\n else\n print(string.format(\"%s:%d: Unknown key in test configuration %s\",\n filename, line_no, key))\n end\n end\n end\n file:close()\n end\n\n return {\n expect_return = expect_return,\n check_stderr = check_stderr,\n build_type = build_type,\n test_type = test_type,\n is_todo = is_todo,\n build_args = build_args,\n }\nend\n\n-- gen_all_tests is a generator of dictionaries. each dictionary has:\n--\n-- name: String, the name of the test\n-- desc: String, a description of the test (unique)\n-- type: either \"plzbuild\" or \"run\"\n-- dir: String, the working directory for the test\n-- output: String, the file name to write the test output to.\n-- depends: List of tests that this test needs before it can run.\n--\n-- plzbuild tests:\n-- These tests will run \"plzbuild\" in a directory, they check that is\n-- returns a zero exit code.\n--\n-- run tests:\n-- These tests will run a plasma program, check that it returns 0.\n-- and compare its output with an exptected output.\n--\n-- expect: String, the path to the expected output file\n-- input: nil or String, the path to an input for stdin\n-- program: String, the path to the Plasma bytecode\n--\ngen_all_tests =\n coroutine.wrap(function()\n function file_is_test(file)\n return file:match(\".exp$\")\n end\n\n local dirs = {}\n function maybe_add_build_dir(dir)\n if (not dirs[dir]) then\n dirs[dir] = {}\n \n local make_file = string.format(\"%s/Makefile\", dir)\n if (lfs.attributes(make_file)) then\n local test = {\n name = \"make\",\n type = \"make\",\n dir = dir,\n desc = string.format(\"%s/Makefile\", dir),\n output = \"make.out\",\n config = {},\n }\n table.insert(dirs[dir], test)\n coroutine.yield(test)\n end\n\n local build_file = string.format(\"%s/BUILD.plz\", dir)\n if (lfs.attributes(build_file)) then\n local test = {\n name = \"BUILD.plz\",\n type = \"plzbuild\",\n dir = dir,\n desc = string.format(\"%s/BUILD.plz\", dir),\n output = \"plzbuild.out\",\n config = {},\n }\n table.insert(dirs[dir], test)\n coroutine.yield(test)\n end\n end\n end\n\n function path_to_test(file, dir)\n maybe_add_build_dir(dir)\n local maybe_input = file:gsub(\".exp\", \".in\")\n if not lfs.attributes(\n string.format(\"%s/%s\", dir, maybe_input))\n then\n maybe_input = nil\n end\n\n function name_if_exists(dir, file, new_ext) \n local path = string.format(\"%s/%s\", dir, file:gsub(\".exp\", new_ext))\n return file_exists(path)\n end\n\n local build_file = name_if_exists(dir, file, \".build\")\n local source_file = name_if_exists(dir, file, \".p\")\n local shell_file = name_if_exists(dir, file, \".sh\")\n local test_file = name_if_exists(dir, file, \".test\")\n local foreign_file = name_if_exists(dir, file, \".cpp\")\n\n local name = file:gsub(\".exp\", \"\")\n local desc = string.format(\"%s/%s\", dir, name)\n local dir_build\n if not build_file and dirs[dir] ~= \"none\" then\n dir_build = dirs[dir]\n end\n\n local config\n\n if build_file then\n config = test_configuration(build_file)\n elseif source_file then\n config = test_configuration(source_file)\n elseif shell_file then\n config = test_configuration(shell_file)\n elseif test_file then\n config = test_configuration(test_file)\n else\n -- Some module tests have neither a build file nor a source file\n config = {}\n end\n\n coroutine.yield({\n name = name,\n type = config.test_type or \"run\",\n dir = dir,\n desc = desc,\n depends = dir_build,\n build_file = build_file and file:gsub(\".exp\", \".build\"),\n shell_file = shell_file and file:gsub(\".exp\", \".sh\"),\n output = file:gsub(\".exp\", \".out\"),\n expect = file,\n input = maybe_input,\n program = file:gsub(\".exp\", \".pz\"),\n foreign_module = foreign_file and file:gsub(\".exp\", \".so\"),\n config = config,\n })\n end\n\n -- a is for 'arg' but I don't want to clubber the real 'arg'.\n for _, a in ipairs(arg) do\n if (file_exists(a .. \".exp\")) then\n local dir, test = string.match(a, \"(.-)/([^/]*)$\")\n path_to_test(test .. \".exp\", dir)\n else\n for path in dir_recursive({a}) do\n if (file_is_test(path.file)) then\n path_to_test(path.file, path.dir)\n end\n end\n end\n end\n end)\n\n\n--\n-- These functions format TAP output\n-------------------------------------\n\n-- Each of the tap_ functions writes a TAP test output line. They all take\n-- the test and stage as the first two parameters.\n\ntest_no = 0\n\n--\n-- Write a generic tap output line based on the status (bool) and any extra\n-- information.\n--\nfunction tap_result(test, stage, status, extra)\n test_no = test_no + 1\n extra = extra and (\" # \" .. extra) or \"\"\n local status_str = status and \"ok\" or \"not ok\"\n print(string.format(\"%s %d %s %s%s\",\n status_str, test_no, test.desc, stage, extra))\nend\n\n--\n-- Indicate that this step was skipped.\n--\nfunction tap_skip(test, stage, why)\n tap_result(test, stage, true, \"SKIP\" .. (why and (\" \" .. why) or \"\"))\nend\n\n--\n-- Indicate that this step was executed with the given how it\n-- exited (\"exited\" or \"killed\") and the exit/signal code.\n--\nfunction tap_exec(test, stage, exit, code, expect_return, is_todo)\n local todo_text = \"\"\n if is_todo then\n todo_text = \"TODO \"..is_todo\n end\n if exit == \"exited\" then\n if code == expect_return then\n tap_result(test, stage, true, todo_text)\n return true\n else\n if is_todo then\n tap_result(test, stage, false, todo_text)\n return true\n else\n tap_result(test, stage, false,\n string.format(\"exited with %d expected %d\", code, expect_return))\n return false\n end\n end\n else\n tap_result(test, stage, false, \"killed by signal \" .. code)\n return false\n end\nend\n\n-- True if at least one test failed, then we should return non-zero\nlocal a_test_failed = false\n\n--\n-- Run a command for testing.\n--\nfunction execute_test_command(test, stage, cmd, args, input,\n exp_out, exp_stderr, exp_return, is_todo)\n exp_return = exp_return or 0\n\n local exit, status, output, stderr = \n execute(test.dir, cmd, args, input, exp_out, exp_stderr)\n local r = tap_exec(test, stage, exit, status, exp_return, is_todo)\n for line in stderr:gmatch(\"[^\\n]+\") do\n print(\" \" .. line)\n end\n if not r then\n a_test_failed = true\n\n -- Maybe enable this for a verbose mode.\n for line in output:gmatch(\"[^\\n]+\") do\n print(\" \" .. line)\n end\n end\n return r\nend\n\n--\n-- This function allows chaining of test steps, and will skip a later step\n-- when an earlier one fails. For example:\n--\n-- local result = true\n-- result = test_step(test, \"step 1\", result, ...)\n-- result = test_step(test, \"step 2\", result, ...)\n-- ...\n--\nfunction test_step(test, stage, prev_result, func)\n local depends_result = true\n if test.depends then\n depends_result = all(test.depends, function(x) return x.result end)\n end\n local result\n if test.config.build_type ~= nil and test.config.build_type ~= build_type then\n tap_skip(test, stage,\n string.format(\"%s test in %s build\",\n test.config.build_type, build_type))\n result = false\n elseif not depends_result then\n tap_skip(test, stage, \"dependecy failed\")\n result = false\n elseif not prev_result then\n tap_skip(test, stage)\n result = false\n else\n result = func()\n end\n test.result = result\n return result\nend\n\n--\n-- Return the number of steps in this test\n--\nfunction test_num_steps(test)\n if test.type == \"plzbuild\" then\n return 1\n elseif test.type == \"compile_failure\" then\n return 2\n elseif test.type == \"run\" then\n if test.build_file then\n return 3\n else\n return 2\n end\n else\n -- Unknown tests are caught later and become part of TAP output.\n return 1\n end\nend\n\nlocal num_tests = 0\nlocal all_tests = {}\nfor test in gen_all_tests do\n num_tests = num_tests + test_num_steps(test)\n table.insert(all_tests, test)\nend\n\n-- The TAP test plan\nprint(\"1..\" .. num_tests)\n\n--\n-- Filter compiler output for processing by diff\n--\nfunction filter_compiler_output(dir, input_name, output_name)\n local input = assert(io.open(dir .. \"/\" .. input_name))\n local output = assert(io.open(dir .. \"/\" .. output_name, \"w\"))\n local all_lines = {}\n -- True if we find the right section of output to filter.\n local output_found = false\n for line in input:lines() do\n table.insert(all_lines, line)\n if line:match(\"^%S+plzc \") or line:match(\"^%S+plzlnk \") then\n output_found = true\n break\n end\n end\n\n if output_found then\n for line in input:lines() do\n if line:match(\"^ninja: build stopped\") or\n line:match(\"^%[%d+/%d+%]\")\n then\n break\n end\n output:write(line .. \"\\n\") \n end\n else\n -- We didn't find the right output, write out everything.\n for _, line in ipairs(all_lines) do\n output:write(line .. \"\\n\")\n end\n end\n\n input:close()\n output:close()\nend\n\n--\n-- Run the test\n--\nfunction run_test(test)\n local result = true -- we start in a good state\n local build_args = {}\n if (test.config.build_args) then\n build_args = test.config.build_args\n end\n local extra_args = {\"--rebuild\"} \n if test.type == \"plzbuild\" then\n result = test_step(test, \"build\", result,\n function()\n return execute_test_command(test, \"build\", plzbuild_bin,\n list_append(extra_args, build_args), nil, nil, nil, 0)\n end)\n elseif test.type == \"make\" then\n result = test_step(test, \"build\", result,\n function()\n return execute_test_command(test, \"make\", \"make\", {}, nil, nil, nil, 0)\n end)\n elseif test.type == \"run\" then\n if (test.build_file) then\n result = test_step(test, \"build\", result,\n function()\n local build_dir = test.name .. \".dir\"\n extra_args = list_append(extra_args,\n {\"--build-file\", test.build_file, \"--build-dir\", build_dir, \"--rebuild\"})\n return execute_test_command(test, \"build\", plzbuild_bin,\n list_append(extra_args, build_args),\n nil, nil, nil, 0)\n end)\n end\n result = test_step(test, \"run\", result,\n function()\n local exp_stdout = nil\n local exp_stderr = nil\n if (test.config.check_stderr) then\n exp_stderr = test.output\n else\n exp_stdout = test.output\n end\n if test.shell_file then\n return execute_test_command(test, \"run\", \"./\"..test.shell_file,\n {}, test.input, exp_stdout, exp_stderr,\n test.config.expect_return, test.config.is_todo)\n else\n local program_str = test.program\n if (test.foreign_module) then\n program_str = program_str .. \":\" .. test.foreign_module\n end\n return execute_test_command(test, \"run\", plzrun_bin, {program_str},\n test.input, exp_stdout, exp_stderr, test.config.expect_return,\n test.config.is_todo)\n end\n end)\n result = test_step(test, \"diff\", result,\n function()\n local filtered_output = test.output:gsub(\".out\", \".outs\")\n -- grep removes entire lines beginning with a #\n -- sed removes the ends of lines after a #\n assert(execute(test.dir, \"sh\", \n {\"-c\", \"grep -v '^#' | sed -e 's/#.*$//'\"},\n test.output, filtered_output))\n return execute_test_command(test, \"diff\", \"diff\",\n {\"-u\", test.expect, filtered_output}, nil, nil, nil)\n end)\n elseif test.type == \"compile_failure\" then\n result = test_step(test, \"build-failure\", result,\n function()\n local build_dir = test.name .. \".dir\"\n local extra_args = {\"--build-dir\", build_dir}\n if (test.build_file) then\n extra_args = list_append(extra_args,\n {\"--build-file\", test.build_file})\n end\n local exp_stdout = nil\n local exp_stderr = nil\n if (test.config.check_stderr) then\n exp_stderr = test.output\n else\n exp_stdout = test.output\n end\n local exp_return = 1\n if test.config.is_todo then\n exp_return = 0\n end\n return execute_test_command(test, \"build-failure\", plzbuild_bin,\n list_append(build_args, extra_args), nil, exp_stdout, exp_stderr,\n exp_return, test.config.is_todo)\n end)\n result = test_step(test, \"diff\", result,\n function()\n local filtered_output = test.output:gsub(\".out\", \".outs\")\n -- grep removes entire lines beginning with a #\n -- sed removes the ends of lines after a #\n filter_compiler_output(test.dir, test.output, filtered_output)\n return execute_test_command(test, \"diff\", \"diff\",\n {\"-u\", test.expect, filtered_output}, nil, nil, nil)\n end)\n else\n tap_result(test, \"unknown test type \"..test.type, false)\n return\n end\nend\n\nfor _, test in pairs(all_tests) do\n run_test(test)\nend\n\nos.exit(a_test_failed and 1 or 0)\n\n" }, { "path": "tests/runtime/BUILD.plz", "content": "# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n\n[allocateLots]\ntype = program\nmodules = [AllocateLots]\n\n[die]\ntype = program\nmodules = [Die]\n\n[parameters]\ntype = program\nmodules = [Parameters]\n\n" }, { "path": "tests/runtime/allocateLots.exp", "content": "item 0\nitem 1\nitem 2\nitem 3\nitem 4\nitem 5\nitem 6\nitem 7\nitem 8\nitem 9\nitem 10\nitem 11\nitem 12\nitem 13\nitem 14\nitem 15\nitem 16\nitem 17\nitem 18\nitem 19\nitem 20\nitem 21\nitem 22\nitem 23\nitem 24\nitem 25\nitem 26\nitem 27\nitem 28\nitem 29\nitem 30\nitem 31\nitem 32\nitem 33\nitem 34\nitem 35\nitem 36\nitem 37\nitem 38\nitem 39\nitem 40\nitem 41\nitem 42\nitem 43\nitem 44\nitem 45\nitem 46\nitem 47\nitem 48\nitem 49\nitem 50\nitem 51\nitem 52\nitem 53\nitem 54\nitem 55\nitem 56\nitem 57\nitem 58\nitem 59\nitem 60\nitem 61\nitem 62\nitem 63\nitem 64\nitem 65\nitem 66\nitem 67\nitem 68\nitem 69\nitem 70\nitem 71\nitem 72\nitem 73\nitem 74\nitem 75\nitem 76\nitem 77\nitem 78\nitem 79\nitem 80\nitem 81\nitem 82\nitem 83\nitem 84\nitem 85\nitem 86\nitem 87\nitem 88\nitem 89\nitem 90\nitem 91\nitem 92\nitem 93\nitem 94\nitem 95\nitem 96\nitem 97\nitem 98\nitem 99\nitem 100\nitem 101\nitem 102\nitem 103\nitem 104\nitem 105\nitem 106\nitem 107\nitem 108\nitem 109\nitem 110\nitem 111\nitem 112\nitem 113\nitem 114\nitem 115\nitem 116\nitem 117\nitem 118\nitem 119\nitem 120\nitem 121\nitem 122\nitem 123\nitem 124\nitem 125\nitem 126\nitem 127\nitem 128\nitem 129\nitem 130\nitem 131\nitem 132\nitem 133\nitem 134\nitem 135\nitem 136\nitem 137\nitem 138\nitem 139\nitem 140\nitem 141\nitem 142\nitem 143\nitem 144\nitem 145\nitem 146\nitem 147\nitem 148\nitem 149\nitem 150\nitem 151\nitem 152\nitem 153\nitem 154\nitem 155\nitem 156\nitem 157\nitem 158\nitem 159\nitem 160\nitem 161\nitem 162\nitem 163\nitem 164\nitem 165\nitem 166\nitem 167\nitem 168\nitem 169\nitem 170\nitem 171\nitem 172\nitem 173\nitem 174\nitem 175\nitem 176\nitem 177\nitem 178\nitem 179\nitem 180\nitem 181\nitem 182\nitem 183\nitem 184\nitem 185\nitem 186\nitem 187\nitem 188\nitem 189\nitem 190\nitem 191\nitem 192\nitem 193\nitem 194\nitem 195\nitem 196\nitem 197\nitem 198\nitem 199\nitem 200\nitem 201\nitem 202\nitem 203\nitem 204\nitem 205\nitem 206\nitem 207\nitem 208\nitem 209\nitem 210\nitem 211\nitem 212\nitem 213\nitem 214\nitem 215\nitem 216\nitem 217\nitem 218\nitem 219\nitem 220\nitem 221\nitem 222\nitem 223\nitem 224\nitem 225\nitem 226\nitem 227\nitem 228\nitem 229\nitem 230\nitem 231\nitem 232\nitem 233\nitem 234\nitem 235\nitem 236\nitem 237\nitem 238\nitem 239\nitem 240\nitem 241\nitem 242\nitem 243\nitem 244\nitem 245\nitem 246\nitem 247\nitem 248\nitem 249\nitem 250\nitem 251\nitem 252\nitem 253\nitem 254\nitem 255\nitem 256\nitem 257\nitem 258\nitem 259\nitem 260\nitem 261\nitem 262\nitem 263\nitem 264\nitem 265\nitem 266\nitem 267\nitem 268\nitem 269\nitem 270\nitem 271\nitem 272\nitem 273\nitem 274\nitem 275\nitem 276\nitem 277\nitem 278\nitem 279\nitem 280\nitem 281\nitem 282\nitem 283\nitem 284\nitem 285\nitem 286\nitem 287\nitem 288\nitem 289\nitem 290\nitem 291\nitem 292\nitem 293\nitem 294\nitem 295\nitem 296\nitem 297\nitem 298\nitem 299\n" }, { "path": "tests/runtime/allocateLots.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\n// This test only works in development builds where the GC is more\n// aggressive.\n// PLZTEST build_type dev\n\nmodule AllocateLots\n\nentrypoint\nfunc main() uses IO -> Int {\n print_heap_size!()\n var collections_start = heap_collections!()\n\n var tree = foldl(insert_wrapper, big_list(), Empty)\n traverse!(print_node, tree)\n print_heap_size!()\n var collections_end = heap_collections!()\n if (collections_end <= collections_start) {\n print!(\"Allocate lots did not GC\\n\")\n return 1\n } else {\n print!(\"# There were \" ++\n int_to_string(collections_end - collections_start) ++\n \" collections during the test.\\n\")\n return 0\n }\n}\n\nfunc heap_collections() uses IO -> Int {\n var res, var collections = Builtin.get_parameter!(\"heap_collections\")\n if (res) {\n print!(\"# There have been \" ++ int_to_string(collections) ++\n \" GCs.\\n\")\n } else {\n Builtin.die(\"Can't retrive heap_collections\\n\")\n }\n return collections\n}\n\nfunc print_heap_size() uses IO {\n var res, var heap_size = Builtin.get_parameter!(\"heap_usage\")\n if (res) {\n print!(\"# Heap_size: \" ++ int_to_string(heap_size/1024) ++ \"KB\\n\")\n } else {\n }\n}\n\nfunc foldl(f : func('x, 'a) -> 'a, l : List('x), a0 : 'a) -> 'a {\n match (l) {\n [] -> {\n return a0\n }\n [var x | var xs] -> {\n var a1 = f(x, a0)\n var a = foldl(f, xs, a1)\n return a\n }\n }\n}\n\nfunc insert_wrapper(x : Int, t : Tree(Int, String)) -> Tree(Int, String) {\n return insert(compare_num, t, x, \"item \" ++ int_to_string(x))\n}\n\nfunc compare_num(a : Int, b : Int) -> Int { return a - b }\n\nfunc print_node(k : Int, v : String) uses IO {\n print!(v ++ \"\\n\")\n}\n\ntype Tree('k, 'v) = Empty\n | Tree(\n left : Tree('k, 'v),\n key : 'k,\n value : 'v,\n right : Tree('k, 'v)\n )\n\nfunc insert(compare : func('k, 'k) -> Int, tree : Tree('k, 'v),\n key : 'k, value : 'v)\n -> Tree('k, 'v)\n{\n match (tree) {\n Empty -> { return Tree(Empty, key, value, Empty) }\n Tree(var left, var tkey, var tvalue, var right) -> {\n if (compare(key, tkey) < 0) {\n return Tree(\n insert(compare, left, key, value),\n tkey, tvalue, right)\n } else {\n return Tree(left, tkey, tvalue,\n insert(compare, right, key, value))\n }\n }\n }\n}\n\nfunc traverse(f : func('k, 'v) uses IO, tree : Tree('k, 'v)) uses IO {\n match (tree) {\n Empty -> {}\n Tree(var left, var key, var value, var right) -> {\n traverse!(f, left)\n f!(key, value)\n traverse!(f, right)\n }\n }\n}\n\nfunc big_list() -> List(Int) {\n return [136, 294, 197, 215, 192, 127, 105, 212, 48, 161, 209, 119, 71,\n 141, 165, 291, 181, 169, 221, 56, 280, 222, 29, 267, 235, 140,\n 54, 157, 80, 37, 234, 242, 12, 53, 92, 194, 102, 200, 43, 179,\n 51, 44, 166, 177, 173, 150, 42, 198, 31, 104, 162, 205, 229,\n 286, 213, 262, 281, 261, 133, 189, 112, 257, 9, 18, 100, 204,\n 75, 57, 299, 28, 269, 47, 138, 41, 66, 25, 288, 109, 185, 130,\n 49, 193, 147, 285, 292, 207, 196, 245, 111, 239, 240, 260, 106,\n 86, 137, 70, 271, 247, 160, 52, 8, 259, 190, 217, 45, 21, 23,\n 91, 79, 117, 0, 270, 236, 99, 59, 223, 295, 64, 206, 38, 3, 224,\n 128, 220, 231, 101, 171, 125, 1, 90, 254, 17, 34, 230, 120, 110,\n 30, 210, 39, 11, 67, 232, 84, 186, 156, 24, 20, 187, 93, 19,\n 163, 266, 108, 132, 195, 129, 116, 146, 178, 69, 33, 26, 290,\n 250, 144, 131, 233, 263, 2, 50, 73, 134, 175, 226, 168, 248,\n 297, 60, 228, 225, 107, 145, 237, 55, 65, 96, 279, 155, 287, 6,\n 256, 296, 182, 293, 202, 46, 152, 118, 265, 201, 218, 149, 15,\n 61, 208, 95, 277, 219, 273, 275, 298, 227, 72, 68, 252, 268,\n 167, 40, 143, 97, 124, 284, 77, 191, 83, 164, 13, 78, 114, 282,\n 126, 244, 148, 58, 278, 238, 82, 115, 113, 211, 98, 289, 151,\n 135, 89, 243, 153, 216, 251, 74, 184, 246, 214, 122, 174, 94, 7,\n 22, 253, 87, 81, 183, 283, 188, 16, 10, 203, 241, 264, 274, 27,\n 159, 4, 276, 88, 32, 158, 154, 139, 14, 255, 199, 5, 121, 272,\n 258, 176, 170, 103, 172, 142, 85, 35, 36, 76, 249, 63, 62, 123,\n 180]\n}\n\n" }, { "path": "tests/runtime/die.exp", "content": "Die: Dieing\n" }, { "path": "tests/runtime/die.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Die\n\n// PLZTEST returns 1\n// PLZTEST output stderr\n\nentrypoint\nfunc main() uses IO -> Int {\n Builtin.die(\"Dieing\")\n \n /*\n * Return shouldn't be necessary since die won't fall-through. However\n * Plasma doesn't yet understand exceptions and we'll implement that once\n * exceptions exist.\n */\n return 0\n}\n\n" }, { "path": "tests/runtime/parameters.exp", "content": "TEST: Squark!: 26\nFailed to get Squark!\nFailed to set Squark! to 26\nFailed to get Squark!\nTEST: heap_usage: 100\nSucceeded to get heap_usage: \nFailed to set heap_usage to 100\nSucceeded to get heap_usage: \nTEST: heap_collections: 100\nSucceeded to get heap_collections: \nFailed to set heap_collections to 100\nSucceeded to get heap_collections: \n" }, { "path": "tests/runtime/parameters.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Parameters\n\nentrypoint\nfunc main() uses IO -> Int {\n test_parameter!(\"Squark!\", 26, Stable)\n test_parameter!(\"heap_usage\", 100, Volatile)\n test_parameter!(\"heap_collections\", 100, Volatile)\n return 0\n}\n\ntype Volatile = Volatile\n | Stable\n\nfunc test_parameter(name : String, value : Int, volatile : Volatile) uses IO {\n print!(\"TEST: \" ++ name ++ \": \" ++ int_to_string(value) ++ \"\\n\")\n\n var res1, var val1 = Builtin.get_parameter!(name)\n print!(pretty_get_result(res1, name, val1, volatile))\n\n var res2 = Builtin.set_parameter!(name, value)\n print!(pretty_set_result(res2, name, value))\n \n var res3, var val3 = Builtin.get_parameter!(name)\n print!(pretty_get_result(res1, name, val3, volatile))\n}\n\nfunc pretty_set_result(res : Bool, label : String, value : Int) -> String {\n var res_str = match (res) {\n True -> \"Succeeded\"\n False -> \"Failed\"\n }\n\n return res_str ++ \" to set \" ++ label ++ \" to \" ++\n int_to_string(value) ++ \"\\n\"\n}\n\nfunc pretty_get_result(res : Bool, label : String, value : Int,\n volatile : Volatile) -> String\n{\n var res_str\n var maybe_value\n match (res) {\n True -> {\n res_str = \"Succeeded\"\n var maybe_hash = match (volatile) {\n Volatile -> \"# \"\n Stable -> \"\"\n }\n maybe_value = \": \" ++ maybe_hash ++ int_to_string(value)\n }\n False -> {\n res_str = \"Failed\"\n maybe_value = \"\"\n }\n }\n\n return res_str ++ \" to get \" ++ label ++ maybe_value ++ \"\\n\"\n}\n\n" }, { "path": "tests/update-outputs.sh", "content": "#!/bin/sh\nset -e\n\n# This script will help update test expected outputs for failed tests. It\n# is useful when line numbers within tests or the compiler's error messages\n# change. The user should check the diffs before committing them.\n\n# Only work in tests directories that incorporate compiler error messages.\nDIRS=\"tests-old/invalid \n tests-old/modules-invalid\"\n\nfor TESTDIR in $DIRS; do\n for OUTPUT in $TESTDIR/*.out; do\n # If the glob didn't match anything then output won't exist.\n if [ -e $OUTPUT ]; then\n BASE=$TESTDIR/`basename $OUTPUT .out`\n # Only copy the file if there's already an .exp file. It's\n # possible there may be a .out file but no .exp if we've\n # switched branches recently. This also has the effect of not\n # updating .expish files, which is good since those must be\n # updated manually.\n if [ -e $BASE.exp ]; then\n mv $OUTPUT $BASE.exp\n fi\n fi\n done\ndone\n\n# Do the same for the new test suite, this will need tweaking as we\n# develop the test suite though.\nTESTDIR=tests/types\nfor OUTPUT in $TESTDIR/*.outs; do\n # If the glob didn't match anything then output won't exist.\n if [ -e $OUTPUT ]; then\n BASE=$TESTDIR/`basename $OUTPUT .outs`\n # Only copy the file if there's already an .exp file. It's\n # possible there may be a .out file but no .exp if we've\n # switched branches recently. This also has the effect of not\n # updating .expish files, which is good since those must be\n # updated manually.\n if [ -e $BASE.exp ]; then\n mv $OUTPUT $BASE.exp\n fi\n fi\ndone\n\n\n" }, { "path": "tests-old/.gitignore", "content": "*.diff\n*.log\n*.out\n*.outs\n*.pzo\n*.pz\n*.plasma-dump_*\n*.trace\n_build\n" }, { "path": "tests-old/README.md", "content": "# Plasma Test Suite\n\nNote that some of the programs in examples/ are also used as part of the\ntest suite.\n\n* [pzt](pzt) - Plasma bytecode tests\n* [modules-invalid](modules-invalid) - Invalid programs that use multiple\n modules\n\n" }, { "path": "tests-old/modules-invalid/.gitignore", "content": "*.pi\n" }, { "path": "tests-old/modules-invalid/BUILD.plz", "content": "[module_08]\ntype = program\nmodules = [Module_08, Module_08.C, Module_08.D]\n\n[module_08b]\ntype = program\nmodules = [Module_08b, Module_08.C, Module_08.D]\n\n" }, { "path": "tests-old/modules-invalid/Makefile", "content": "#\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# vim: noet sw=4 ts=4\n#\n\nTOP=../..\n\n.PHONY: all\nall:\n\t@echo This Makefile does not have an \"all\" target\n\t@echo Use the run_tests.sh script in the parent directory to run all tests\n\t@echo or use \"make test_name.test\" to run a single test.\n\t@false\n\n.PRECIOUS: %.out\n%.out : %.p $(TOP)/src/plzc\n\tif $(TOP)/src/plzc $< > $@ 2>&1 ; then \\\n\t\techo \"Compilation succeeded\" ; \\\n\t\techo \"Compilation succeeded\" >> $@ ; \\\n\t\tfalse ; \\\n\tfi\n\nmodule_03.out : module_03a.pi\nmodule_04a.out : module_04import.pi\nmodule_04b.out : module_04import.pi\nmodule_04c.out : module_04import.pi\nmodule_04d.out : module_04import.pi\n\nmodule_02a.pi: ;\n\n%.pi : %.p $(TOP)/src/plzc\n\t$(TOP)/src/plzc --mode make-interface $<\n\n%.pzo : %.p $(TOP)/src/plzc\n\t$(TOP)/src/plzc $<\n\n%.pz : %.pzo $(TOP)/src/plzlnk\n\t$(TOP)/src/plzlnk -n ${subst .pz,,$@} -o $@ $<\n\nmodule_05.out : module_05.pzo module_05_.pzo $(TOP)/src/plzlnk\n\tif $(TOP)/src/plzlnk module_05.pzo module_05_.pzo \\\n\t\t\t-n Module_05 -o module_05.pz > $@ 2>&1 ; then \\\n\t\techo \"Linking succeeded\" ; \\\n\t\techo \"Linking succeeded\" >> $@ ; \\\n\t\tfalse ; \\\n\tfi\n\nmodule_06.out : module_06.p $(TOP)/src/plzc module_06a.pi\n\nmodule_08.out : module_08.p module_08.c.p module_08.d.p BUILD.plz BINS\n\tif $(TOP)/src/plzbuild module_08 > $@ 2>&1 ; then \\\n\t\techo \"Build succeeded\" ; \\\n\t\techo \"Build succeeded\" >> $@ ; \\\n\t\tfalse ; \\\n\tfi\nmodule_08b.out : module_08b.p module_08.c.p module_08.d.p BUILD.plz BINS\n\tif $(TOP)/src/plzbuild module_08b > $@ 2>&1 ; then \\\n\t\techo \"Build succeeded\" ; \\\n\t\techo \"Build succeeded\" >> $@ ; \\\n\t\tfalse ; \\\n\tfi\n\n.PHONY: BINS\nBINS: $(TOP)/src/plzc $(TOP)/src/plzlnk $(TOP)/src/plzbuild\n\n.PHONY: %.test\n%.test : %.exp %.outs\n\tdiff -u $^\n\n.PHONY: %.test\n%.test : %.expish %.outs\n\tgrep -cF -f $^\n\n%.outs : %.out\n\tgrep -v '^#' < $< | sed -e 's/#.*$$//' > $@\n\n.PHONY: clean\nclean:\n\trm -rf *.pz *.pzo *.out *.diff *.log *.trace\n\trm -f module_03a.pi module_04import.pi module_06a.pi\n\trm -rf _build\n\n.PHONY: realclean\nrealclean: clean\n\trm -rf *.plasma-dump_*\n\n" }, { "path": "tests-old/modules-invalid/module_01.exp", "content": "module_01.p:10: The interface file for the imported module (Module_01a) cannot\n be found. Was the module listed in BUILD.plz?\n" }, { "path": "tests-old/modules-invalid/module_01.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_01\n\n// The imported module cannot be found.\nimport Module_01a\n\nexport\nfunc main() uses IO -> Int {\n return 0\n}\n\n" }, { "path": "tests-old/modules-invalid/module_02.exp", "content": "module_02a.pi:8: The interface file 'module_02a.pi' describes the wrong module,\n got: 'BogusName' expected: 'Module_02a'\n" }, { "path": "tests-old/modules-invalid/module_02.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_02\n\n// The interface matching this module name has the wrong module inside it.\nimport Module_02a\n\nexport\nfunc main() uses IO -> Int {\n return 0\n}\n\n" }, { "path": "tests-old/modules-invalid/module_03.exp", "content": "module_03.p:11: The import of 'Module_03a' clobbers a previous import to that\n name\nmodule_03.p:11: Warning: The import of 'Module_03a' is redundant, this module\n is already imported\n" }, { "path": "tests-old/modules-invalid/module_03.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_03\n\n// Duplicate import\nimport Module_03a\nimport Module_03a\n\nexport\nfunc main() uses IO -> Int {\n return 0\n}\n\n" }, { "path": "tests-old/modules-invalid/module_03a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_03a\n\n" }, { "path": "tests-old/modules-invalid/module_04a.exp", "content": "module_04a.p:14: \"int\" and \"string\" are not the same\n" }, { "path": "tests-old/modules-invalid/module_04a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_04a\n\nimport Module_04import\n\nexport\nfunc main() uses IO -> Int {\n // Mismatched type in imported function's use.\n _ = Module_04import.someInt(3)\n\n return 0\n}\n\n" }, { "path": "tests-old/modules-invalid/module_04b.exp", "content": "module_04b.p:14: Wrong number of parameters in function call, expected 1 got 0\n" }, { "path": "tests-old/modules-invalid/module_04b.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_04b\n\nimport Module_04import\n\nexport\nfunc main() uses IO -> Int {\n // Mismatched number of parameters\n _ = Module_04import.someInt()\n\n return 0\n}\n\n" }, { "path": "tests-old/modules-invalid/module_04c.exp", "content": "module_04c.p:14: Arity error got 1 values, but 0 values were expected\n" }, { "path": "tests-old/modules-invalid/module_04c.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_04c\n\nimport Module_04import\n\nexport\nfunc main() uses IO -> Int {\n // Mismatched arity\n Module_04import.someInt(\"Boo\")\n\n return 0\n}\n\n" }, { "path": "tests-old/modules-invalid/module_04d.exp", "content": "module_04d.p:20: One or more resources needed for this call is unavailable in\n this function\n" }, { "path": "tests-old/modules-invalid/module_04d.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_04d\n\nimport Module_04import\n\nexport\nfunc main() uses IO -> Int {\n _ = test()\n\n return 0\n}\n\nfunc test() -> Int {\n // Mismatched resources\n Module_04import.someAction!()\n\n return 1\n}\n\n\n" }, { "path": "tests-old/modules-invalid/module_04import.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_04import\n\nexport func someInt(v : String) -> Int { return 0 }\nexport func someAction() uses IO {}\n\n" }, { "path": "tests-old/modules-invalid/module_05.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma bytecode linker. Sorry.\nMessage: Cannot link two modules containing the same module\nplzlnk location: predicate `pz.link.calculate_offsets_and_build_maps'/20\nplzlnk file: pz.link.m\n" }, { "path": "tests-old/modules-invalid/module_05.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_05\n\n// This file and module_05_.p contain the same module, linking them should\n// cause an error.\n\nexport\nfunc main() uses IO -> Int {\n return 0\n}\n\n" }, { "path": "tests-old/modules-invalid/module_05_.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_05\n\nexport\nfunc main_() uses IO -> Int {\n return 0\n}\n\n" }, { "path": "tests-old/modules-invalid/module_06.exp", "content": "A compilation error occured and this error is not handled gracefully\nby the Plasma compiler. Sorry.\nMessage: Unknown symbol: Module_06a.Foo\nContext: module_06.p:15\nplzc location: predicate `pre.from_ast.ast_to_pre_expr_2'/7\nplzc file: pre.from_ast.m\n" }, { "path": "tests-old/modules-invalid/module_06.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_06\n\nimport Module_06a\n\nexport\nfunc main() uses IO -> Int {\n // The foo type is abstractly-exported, we should not be able to access\n // the constructor.\n var f = Module_06a.Foo(3)\n Module_06a.Foo(var n) = f\n\n return 0\n}\n\n" }, { "path": "tests-old/modules-invalid/module_06a.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_06a\n\nexport opaque\ntype Foo = Foo ( a : Int )\n\nexport\nfunc makeFoo(n : Int) -> Foo {\n return Foo(n*3)\n}\n\nexport\nfunc fooStr(f : Foo) -> String {\n Foo(var n) = f\n return \"Foo(\" ++ int_to_string(n) ++ \")\"\n}\n\n" }, { "path": "tests-old/modules-invalid/module_07.exp", "content": "module_07.p:9: The interface file for the imported module (Foo) cannot be\n found. Was the module listed in BUILD.plz?\nmodule_07.p:10: The import of 'Bar' clobbers 'F' which is used by a previous\n import\nmodule_07.p:10: The interface file for the imported module (Bar) cannot be\n found. Was the module listed in BUILD.plz?\n" }, { "path": "tests-old/modules-invalid/module_07.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module07\n\nimport Foo as F\nimport Bar as F\n\n" }, { "path": "tests-old/modules-invalid/module_08.c.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_08.C\n\nimport Module_08.D as D\n\nexport\nresource Res1 from IO\nexport\nresource Res3 from D.Res2\n\nexport\nfunc test1() uses D.Res4 {\n}\n\nexport\nfunc test2() uses Res3 {\n}\n\n" }, { "path": "tests-old/modules-invalid/module_08.d.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_08.D\n\nimport Module_08.C as C\n\nexport\nresource Res2 from C.Res1\nexport\nresource Res4 from C.Res3\n\n" }, { "path": "tests-old/modules-invalid/module_08.expish", "content": "module_08.p:19: One or more resources needed for this call is unavailable in\n this function\nmodule_08.p:15: One or more resources needed for this call is unavailable in\n this function\nmodule_08.p:18: One or more resources needed for this call is unavailable in\n this function\n" }, { "path": "tests-old/modules-invalid/module_08.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_08\n\n// Import C but not D, show that we can use both C's resources, even the\n// one that depends on D.\nimport Module_08.C as C\n\nfunc testCallsCRes3() uses IO {\n // Using a resource from Module D does not work.\n C.test1!()\n\n // Or even using a resource from module C that is \"from\" a resource in D\n C.test2!()\n my_test!()\n}\n\nfunc my_test() uses C.Res3 {\n}\n\n" }, { "path": "tests-old/modules-invalid/module_08b.expish", "content": "module_08b.p:14: Unknown resource 'D.Res2'\nmodule_08b.p:14: Unknown resource 'Module_08.D.Res2'\n" }, { "path": "tests-old/modules-invalid/module_08b.p", "content": "/*\n * vim: ft=plasma\n * This is free and unencumbered software released into the public domain.\n * See ../LICENSE.unlicense\n */\n\nmodule Module_08b\n\n// Import C but not D, show that we can use both C's resources, even the\n// one that depends on D.\nimport Module_08.C as C\n\n// These resources shouldn't exist in this environment.\nfunc bad_use() uses (D.Res2, Module_08.D.Res2) {\n}\n\n" }, { "path": "tests-old/pzt/Makefile", "content": "#\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# vim: noet sw=4 ts=4\n#\n\nTOP=../..\n\n.PHONY: all \nall:\n\t@echo This Makefile does not have an \"all\" target\n\t@echo Use the run_tests.sh script in the parent directory to run all tests\n\t@echo or use \"make test_name.test\" to run a single test.\n\t@false\n\n%.pzo : %.pzt $(TOP)/src/plzasm\n\t$(TOP)/src/plzasm $<\n\n%.pz : %.pzo $(TOP)/src/plzlnk\n\t$(TOP)/src/plzlnk -n ${subst .pz,,$@} -o $@ $<\n\nlink_01.pz : link_01.pzo link_target_01.pzo $(TOP)/src/plzlnk\n\t$(TOP)/src/plzlnk -n ${subst .pz,,$@} -e link_01.main_closure -o $@ link_01.pzo link_target_01.pzo\nlink_02.pz : link_02.pzo link_target_01.pzo $(TOP)/src/plzlnk\n\t$(TOP)/src/plzlnk -n ${subst .pz,,$@} -e link_02.main_closure -o $@ link_02.pzo link_target_01.pzo\nlink_03.pz : link_03.pzo link_target_02.pzo $(TOP)/src/plzlnk\n\t$(TOP)/src/plzlnk -n ${subst .pz,,$@} -e link_03.main_closure -o $@ link_03.pzo link_target_02.pzo\n\n.PHONY: %.test\n%.test : %.exp %.out\n\tdiff -u $^ \n\n.PHONY: %.gctest\n%.gctest : %.pz $(TOP)/runtime/plzrun\n\tPZ_RUNTIME_DEV_OPTS=gc_zealous $(TOP)/runtime/plzrun $< > /dev/null\n\n%.out : %.pz $(TOP)/runtime/plzrun\n\t$(TOP)/runtime/plzrun $< > $@\n\n.PHONY: clean\nclean:\n\trm -rf *.pz *.pzo *.out *.diff *.log\n\n.PHONY: realclean\nrealclean: clean\n\n" }, { "path": "tests-old/pzt/ccov.exp", "content": "Hello closure\nHello proc\nHello closure tail\nHello proc tail\nHello ind\nHello ind tail\n" }, { "path": "tests-old/pzt/ccov.pzt", "content": "// Test calling conventions\n\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule ccov;\n\n// Constant static data.\n// data NAME = TYPE VALUE;\ndata hello_string = string { 72 101 108 108 111 32 };\ndata closure_string = string { 99 108 111 115 117 114 101 10 };\ndata proc_string = string { 112 114 111 99 10 };\ndata closure_tail_string = string {\n 99 108 111 115 117 114 101 32 116 97 105 108 10 };\ndata proc_tail_string = string {\n 112 114 111 99 32 116 97 105 108 10 };\ndata ind_string = string {\n 105 110 100 10 };\ndata ind_tail_string = string {\n 105 110 100 32 116 97 105 108 10 };\n\n// Forward declaration for imported procedure.\n// These are required for the assembler to build the string table and will\n// be encoded into the PZ bytecode so that a code generator can see the\n// signature of the call.\nimport Builtin.print (ptr - );\nimport Builtin.string_concat (ptr ptr - ptr);\n\nproc test_proc (ptr - ) {\n get_env\n dup\n load main_env_struct 2:ptr\n load main_env_struct 3:ptr\n drop\n // Stack: who env greeting strcat\n pick 4\n swap\n call_ind\n\n // Stack: who env message\n swap\n load main_env_struct 1:ptr drop\n // Stack: who message print\n call_ind\n\n drop\n ret\n};\n\n// proc test_proc_tcall (ptr - ) {\n// get_env\n// dup\n// load main_env_struct 2:ptr\n// load main_env_struct 3:ptr\n// drop\n// // Stack: who env greeting strcat\n// roll 4\n// swap\n// call_ind\n// \n// // Stack: env message\n// swap\n// load main_env_struct 1:ptr drop\n// // Stack: message print\n// tcall_ind\n// };\n\nclosure test_clo = test_proc main_env;\n\nproc tcall_test1 ( - ) {\n // A closure tail call.\n get_env load main_env_struct 6:ptr drop\n tcall test_clo\n};\n\nproc tcall_test2 ( - ) {\n // A proc tail call.\n get_env load main_env_struct 7:ptr drop\n tcall test_proc\n};\n\nproc tcall_test3 ( - ) {\n // A proc tail call.\n get_env\n load main_env_struct 9:ptr\n load main_env_struct 10:ptr\n drop\n tcall_ind\n};\n\nproc main_proc (- w) {\n get_env\n\n // Use a closure call to the same environment.\n load main_env_struct 4:ptr swap\n call test_clo\n\n // use a proc call, this is an optimsation, but it's very common.\n load main_env_struct 5:ptr swap\n call test_proc\n\n call tcall_test1\n\n call tcall_test2\n \n // use a indirect call.\n load main_env_struct 8:ptr\n load main_env_struct 10:ptr\n roll 3 roll 3\n call_ind\n\n call tcall_test3\n\n drop\n\n 0 ret\n};\n\nstruct main_env_struct { ptr ptr ptr ptr ptr ptr ptr ptr ptr ptr };\ndata main_env = main_env_struct {\n Builtin.print\n hello_string\n Builtin.string_concat\n closure_string\n proc_string\n closure_tail_string\n proc_tail_string\n ind_string\n ind_tail_string\n test_clo\n};\n\n// Build a closure.\nexport\nclosure main_closure = main_proc main_env;\n\nentry main_closure;\n\n" }, { "path": "tests-old/pzt/closure.exp", "content": "Hello\nGoodbye\n" }, { "path": "tests-old/pzt/closure.pzt", "content": "// Hello world example\n\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule closure_;\n\ndata hello_string = string { 72 101 108 108 111 10 };\n\nimport Builtin.print (ptr - );\n\nproc main_p (- w) {\n // Place the current environment on the stack for later checking.\n get_env\n\n // Make and call a closure.\n dup\n load main_s 1:ptr drop\n get_env\n alloc my_env\n store my_env 1:ptr\n store my_env 2:ptr\n make_closure foo\n call_ind\n\n // Call the statically created closure\n get_env load main_s 3:ptr drop\n call_ind\n\n // Get the env again and compare it with the previous one.\n get_env\n // Should return zero.\n eq not ret\n};\n\nstruct my_env { ptr ptr };\nproc foo (-) {\n get_env\n load my_env 2:ptr\n\n load my_env 1:ptr drop\n load main_s 2:ptr drop\n call_ind\n\n ret\n};\n\ndata goodbye_string = string { 71 111 111 100 98 121 101 10 };\ndata closure2_env = my_env { main_d goodbye_string };\nclosure closure2 = foo closure2_env;\n\nstruct main_s { ptr ptr ptr };\ndata main_d = main_s { hello_string Builtin.print closure2 };\n\nexport\nclosure main = main_p main_d;\nentry main;\n\n" }, { "path": "tests-old/pzt/fib.exp", "content": "fibs(35) = 14930352\n" }, { "path": "tests-old/pzt/fib.pzt", "content": "// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule fib;\n\nimport Builtin.print (ptr - );\nimport Builtin.int_to_string (w - ptr);\n\nproc print_int (w -) {\n call Builtin.int_to_string\n call Builtin.print\n ret\n};\n\nproc fibs (w - w) {\n block entry_ {\n // if the input is less than two jump to the base case\n dup 2 lt_u cjmp base\n // Otherwise execute the recursive calls, and add their results.\n dup\n 1 sub call fibs swap 2 sub call fibs\n add\n ret\n }\n block base {\n drop\n 1\n ret\n }\n};\n\nproc main_p ( - w) {\n get_env\n load main_s 3:ptr\n load main_s 2:ptr\n load main_s 1:ptr\n drop\n\n // consume label1\n call Builtin.print\n 35 call print_int\n // Consume label2\n call Builtin.print\n 35 call fibs\n call Builtin.int_to_string\n call Builtin.print\n // Consome nl\n call Builtin.print\n 0 ret\n};\n\ndata nl = string { 10 0 };\ndata label1 = string { 102 105 98 115 40 };\ndata label2 = string { 41 32 61 32 };\n\nstruct main_s { ptr ptr ptr };\ndata main_d = main_s { label1 label2 nl };\nexport closure main = main_p main_d;\nentry main;\n\n" }, { "path": "tests-old/pzt/hello.exp", "content": "Hello\n" }, { "path": "tests-old/pzt/hello.pzt", "content": "// Hello world example\n\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule hello;\n\n// Entries all begin with a keyword saying what type of entry they\n// are. Here we have data and proc. Extra keywords will be needed later\n// for sharing/linkage stuff.\n\n// Constant static data.\n// data NAME = TYPE VALUE;\ndata hello_string = string { 72 101 108 108 111 10 };\n\n// Forward declaration for imported procedure.\n// These are required for the assembler to build the string table and will\n// be encoded into the PZ bytecode so that a code generator can see the\n// signature of the call.\nimport Builtin.print (ptr - );\n\nproc main_proc (- w) {\n get_env\n load main_env_struct 2:ptr\n load main_env_struct 1:ptr drop\n call_ind\n\n 0 ret\n};\n\nstruct main_env_struct { ptr ptr };\ndata main_env = main_env_struct { Builtin.print hello_string };\n\n// Build a closure.\nexport\nclosure main_closure = main_proc main_env;\nentry main_closure;\n\n" }, { "path": "tests-old/pzt/link_01.exp", "content": "Hello\n" }, { "path": "tests-old/pzt/link_01.p", "content": "" }, { "path": "tests-old/pzt/link_01.pzt", "content": "\nmodule link_01;\n\ndata hello_string = string { 72 101 108 108 111 10 };\n\nimport Builtin.print (ptr - );\n\nproc main_proc (- w) {\n get_env\n load main_env_struct 2:ptr\n load main_env_struct 1:ptr drop\n call_ind\n\n 0 ret\n};\n\nstruct main_env_struct { ptr ptr };\ndata main_env = main_env_struct { Builtin.print hello_string };\n\n// Build a closure.\nexport\nclosure link_01.main_closure = main_proc main_env;\nentry link_01.main_closure;\n\n" }, { "path": "tests-old/pzt/link_02.exp", "content": "Hello\ngoodbye\n" }, { "path": "tests-old/pzt/link_02.pzt", "content": "\nmodule link_02;\n\ndata hello_string = string { 72 101 108 108 111 10 };\n\nimport Builtin.print (ptr - );\nimport link_target_01.goodbye_closure ( - );\n\nproc main_proc (- w) {\n get_env\n load main_env_struct 2:ptr\n load main_env_struct 1:ptr drop\n call_ind\n\n get_env\n load main_env_struct 3:ptr drop\n call_ind\n\n 0 ret\n};\n\nstruct main_env_struct { ptr ptr ptr };\ndata main_env = main_env_struct { Builtin.print hello_string\n link_target_01.goodbye_closure };\n\n// Build a closure.\nexport\nclosure link_02.main_closure = main_proc main_env;\nentry link_02.main_closure;\n\n" }, { "path": "tests-old/pzt/link_03.exp", "content": "Hello\nPaul\ngoodbye\n" }, { "path": "tests-old/pzt/link_03.pzt", "content": "\nmodule link_03;\n\ndata hello_string = string { 72 101 108 108 111 10 };\ndata name_string = string { 80 97 117 108 10 };\n\nimport Builtin.print (ptr - );\nimport link_target_02.goodbye_closure ( - );\n\nproc main_proc (- w) {\n get_env\n load main_env_struct 2:ptr\n load main_env_struct 1:ptr drop\n call_ind\n\n get_env\n load main_env_struct 3:ptr drop\n call_ind\n\n 0 ret\n};\n\nproc name_proc (- w) {\n get_env\n load main_env_struct 4:ptr drop\n ret\n};\n\nstruct main_env_struct { ptr ptr ptr ptr };\ndata main_env = main_env_struct {\n Builtin.print\n hello_string\n link_target_02.goodbye_closure\n name_string\n};\n\n// Build a closure.\nexport\nclosure link_03.main_closure = main_proc main_env;\nentry link_03.main_closure;\n\nexport closure link_03.name_closure = name_proc main_env;\n\n" }, { "path": "tests-old/pzt/link_target_01.pzt", "content": "\nmodule link_target_01;\n\ndata goodbye_string = string { 103 111 111 100 98 121 101 10 };\n\nimport Builtin.print (ptr - );\n\nproc goodbye_proc (-) {\n get_env\n load goodbye_env_struct 2:ptr\n load goodbye_env_struct 1:ptr drop\n call_ind\n\n ret\n};\n\nstruct goodbye_env_struct { ptr ptr };\ndata goodbye_env = goodbye_env_struct { Builtin.print goodbye_string };\n\n// Build a closure.\nexport closure link_target_01.goodbye_closure = goodbye_proc goodbye_env;\n\n\n" }, { "path": "tests-old/pzt/link_target_02.pzt", "content": "\nmodule link_target_02;\n\ndata goodbye_string = string { 103 111 111 100 98 121 101 10 };\n\nimport Builtin.print (ptr - );\n\nimport link_03.name_closure (- ptr);\n\nproc goodbye_proc (-) {\n get_env\n load goodbye_env_struct 3:ptr drop\n call_ind\n\n get_env\n load goodbye_env_struct 1:ptr drop\n call_ind\n\n get_env\n load goodbye_env_struct 2:ptr\n load goodbye_env_struct 1:ptr drop\n call_ind\n\n ret\n};\n\nstruct goodbye_env_struct { ptr ptr ptr };\ndata goodbye_env = goodbye_env_struct {\n Builtin.print\n goodbye_string \n link_03.name_closure\n};\n\n// Build a closure.\nexport closure link_target_02.goodbye_closure = goodbye_proc goodbye_env;\n\n" }, { "path": "tests-old/pzt/memory.exp", "content": "15\n120\n" }, { "path": "tests-old/pzt/memory.pzt", "content": "// Test memory operations\n\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule memory;\n\nstruct cons { w ptr };\n\nimport Builtin.print (ptr - );\nimport Builtin.int_to_string (w - ptr);\nimport Builtin.string_concat (ptr ptr - ptr);\n\nproc print_int_nl(w -) {\n call Builtin.int_to_string\n get_env load main_s 1:ptr drop\n call Builtin.string_concat\n call Builtin.print\n ret\n};\n\nproc make_list(w - ptr) {\n block entry_ {\n dup 0 eq cjmp base jmp rec\n }\n block base {\n drop 0 ze:w:ptr ret\n }\n block rec {\n dup\n 1 sub call make_list\n alloc cons\n // On the stack are: word1 word2 ptr, store returns the ptr so we\n // can chain these.\n store cons 2:ptr\n store cons 1:ptr\n ret\n }\n};\n\nproc sum_list(w ptr - w) {\n block entry_ {\n dup 0 ze:w:ptr eq cjmp base jmp rec\n }\n block base {\n drop ret\n }\n block rec {\n // acc0 ptr0\n load cons 1:ptr\n // acc0 val ptr0\n swap roll 3 add swap\n // acc ptr0\n load cons 2:ptr\n drop\n // acc ptr\n tcall sum_list\n }\n};\n\nproc mul_list(ptr - w) {\n block entry_ {\n dup 0 ze:w:ptr eq cjmp base jmp rec\n }\n block base {\n drop ret\n }\n block rec {\n // acc0 ptr0\n load cons 1:ptr\n // acc0 ptr0 val\n swap roll 3 mul swap\n // acc ptr0\n load cons 2:ptr\n drop\n // acc ptr\n tcall mul_list\n }\n};\n\nproc main_p (- w) {\n 5 call make_list\n dup 0 swap call sum_list call print_int_nl\n 1 swap call mul_list call print_int_nl\n\n 0 ret\n};\n\ndata nl_string = string { 10 };\nstruct main_s { ptr };\ndata main_d = main_s { nl_string };\nexport\nclosure main = main_p main_d;\nentry main;\n\n" }, { "path": "tests-old/pzt/mutual.exp", "content": "35 is odd\n" }, { "path": "tests-old/pzt/mutual.pzt", "content": "\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule mutual;\n\nimport Builtin.print (ptr - );\nimport Builtin.int_to_string (w - ptr);\n\nproc neq (w w - w) {\n eq not ret\n};\n\nproc is_odd (w - w) {\n block entry_ {\n // If the input doesn't equal 0 then make a recursive call\n dup 0 call neq cjmp reccall\n // Otherwise return false\n drop 0 ret\n }\n block reccall {\n 1 sub tcall is_even\n }\n};\n\nproc is_even (w - w) {\n block entry_ {\n // If the input doesn't equal 0 then make a recursive call\n dup 0 call neq cjmp reccall\n // Otherwise return true\n drop 1 ret\n }\n block reccall {\n 1 sub tcall is_odd\n }\n};\n\nproc main_p ( - w) {\n block entry_ {\n 35 call is_odd\n 0 eq cjmp even_block\n get_env load main_s 2:ptr drop call Builtin.print\n 0 ret\n }\n block even_block {\n get_env load main_s 1:ptr drop call Builtin.print\n 0 ret\n }\n};\n\ndata is_even_label = string { 51 53 32 105 115 32 101 118 101 110 10 };\ndata is_odd_label = string { 51 53 32 105 115 32 111 100 100 10 };\n\nstruct main_s { ptr ptr };\ndata main_d = main_s { is_even_label is_odd_label };\nexport\nclosure main = main_p main_d;\nentry main;\n" }, { "path": "tests-old/pzt/stack.exp", "content": "dup 4 4 3 2 1 \ndrop 3 2 1 \nswap 3 4 2 1 \nroll(3) 2 4 3 1 \nroll(4) 1 4 3 2 \npick(3) 2 4 3 2 1 \npick(4) 1 4 3 2 1 \n" }, { "path": "tests-old/pzt/stack.pzt", "content": "// Stack manipulations\n\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule stack;\n\nimport Builtin.print (ptr - );\nimport Builtin.int_to_string (w - ptr);\n\nproc print_int (w -) {\n call Builtin.int_to_string call Builtin.print\n get_env load main_s 1:ptr drop call Builtin.print\n ret\n};\n\nproc print_int_n (w -) {\n block entry_ {\n dup 0 eq not cjmp rec drop ret\n }\n block rec {\n swap\n call print_int\n 1 sub\n tcall print_int_n\n }\n};\n\nproc print_nl (-) {\n get_env load main_s 2:ptr drop call Builtin.print ret\n};\n\nproc values (- w w w w) {\n 1 2 3 4 ret\n};\n\nproc main_p (- w) {\n // 0 goes on the stack now as the program's return code, and to show\n // that it is undisturbed doring the test.\n 0\n get_env\n\n load main_s 3:ptr swap call Builtin.print\n call values\n dup\n 5 call print_int_n\n call print_nl\n\n load main_s 4:ptr swap call Builtin.print\n call values\n drop\n 3 call print_int_n\n call print_nl\n\n load main_s 5:ptr swap call Builtin.print\n call values\n swap\n 4 call print_int_n\n call print_nl\n\n load main_s 6:ptr swap call Builtin.print\n call values\n roll 3\n 4 call print_int_n\n call print_nl\n\n load main_s 7:ptr swap call Builtin.print\n call values\n roll 4\n 4 call print_int_n\n call print_nl\n\n load main_s 8:ptr swap call Builtin.print\n call values\n pick 3\n 5 call print_int_n\n call print_nl\n\n load main_s 9:ptr swap call Builtin.print\n call values\n pick 4\n 5 call print_int_n\n call print_nl\n\n drop // env\n ret // 0\n};\n\ndata space = string {32};\ndata nl = string {10};\ndata dup_str = string {100 117 112 32};\ndata drop_str = string {100 114 111 112 32};\ndata swap_str = string {115 119 97 112 32};\ndata roll3_str = string {114 111 108 108 40 51 41 32};\ndata roll4_str = string {114 111 108 108 40 52 41 32};\ndata pick3_str = string {112 105 99 107 40 51 41 32};\ndata pick4_str = string {112 105 99 107 40 52 41 32};\n\nstruct main_s { ptr ptr ptr ptr ptr ptr ptr ptr ptr };\ndata main_d = main_s { space nl dup_str drop_str swap_str roll3_str\n roll4_str pick3_str pick4_str };\nexport\nclosure main = main_p main_d;\nentry main;\n" }, { "path": "tests-old/pzt/struct.exp", "content": "Hello\n3\n9\n27\n" }, { "path": "tests-old/pzt/struct.pzt", "content": "// Structs example\n\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule struct_;\n\ndata hello_string = string { 72 101 108 108 111 10 };\n\nstruct test_struct { ptr w16 w16 w };\n\n// Test that a data item can create a struct.\ndata test_data = test_struct { hello_string 3 9 27 };\n\nimport Builtin.print (ptr - );\nimport Builtin.int_to_string (w - ptr);\nimport Builtin.string_concat (ptr ptr - ptr);\n\nproc main_p (- w) {\n get_env load main_s 1:ptr drop\n load test_struct 1 :ptr swap\n call Builtin.print\n load test_struct 2 :w16 swap\n ze:w16:w call print_int\n load test_struct 3 :w16 swap\n ze:w16:w call print_int\n load test_struct 4 :w drop\n call print_int\n\n 0 ret\n};\n\ndata nl = string { 10 0 };\n\nproc print_int(w -) {\n call Builtin.int_to_string\n get_env load main_s 2:ptr drop\n call Builtin.string_concat call Builtin.print\n ret\n};\n\nstruct main_s { ptr ptr };\ndata main_d = main_s { test_data nl };\nexport\nclosure main = main_p main_d;\nentry main;\n" }, { "path": "tests-old/pzt/tags.exp", "content": "12\n13\n38\n39\n256 0\n256 1\n256 2\n256 3\n64 0\n64 1\n64 2\n64 3\n" }, { "path": "tests-old/pzt/tags.pzt", "content": "// Hello world example\n\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule tags;\n\ndata nl_string = string { 10 };\ndata spc_string = string { 32 };\n\nimport Builtin.print (ptr - );\nimport Builtin.int_to_string (w - ptr);\nimport Builtin.string_concat (ptr ptr - ptr);\n\nimport Builtin.make_tag (ptr ptr - ptr);\nimport Builtin.shift_make_tag (ptr ptr - ptr);\nimport Builtin.break_tag (ptr - ptr ptr);\nimport Builtin.break_shift_tag (ptr - ptr ptr);\n\nproc print_int_nl(w -) {\n call Builtin.int_to_string\n get_env load main_s 1:ptr drop\n call Builtin.string_concat\n call Builtin.print\n ret\n};\n\nproc print_2_int_nl(w w -) {\n swap\n call Builtin.int_to_string\n swap\n call Builtin.int_to_string\n \n // spc\n get_env load main_s 2:ptr drop\n swap\n // nl\n get_env load main_s 1:ptr drop\n\n call Builtin.string_concat\n call Builtin.string_concat\n call Builtin.string_concat\n call Builtin.print\n\n ret\n};\n\nproc main_p (- w) {\n 12 ze:w32:ptr 0 ze:w32:ptr call Builtin.make_tag call print_int_nl\n 12 ze:w32:ptr 1 ze:w32:ptr call Builtin.make_tag call print_int_nl\n 9 ze:w32:ptr 2 ze:w32:ptr call Builtin.shift_make_tag call print_int_nl\n 9 ze:w32:ptr 3 ze:w32:ptr call Builtin.shift_make_tag call print_int_nl\n\n 256 ze:w32:ptr call Builtin.break_tag call print_2_int_nl\n 257 ze:w32:ptr call Builtin.break_tag call print_2_int_nl\n 258 ze:w32:ptr call Builtin.break_tag call print_2_int_nl\n 259 ze:w32:ptr call Builtin.break_tag call print_2_int_nl\n\n 256 ze:w32:ptr call Builtin.break_shift_tag call print_2_int_nl\n 257 ze:w32:ptr call Builtin.break_shift_tag call print_2_int_nl\n 258 ze:w32:ptr call Builtin.break_shift_tag call print_2_int_nl\n 259 ze:w32:ptr call Builtin.break_shift_tag call print_2_int_nl\n\n 0 ret\n};\n\nstruct main_s { ptr ptr };\ndata main_d = main_s { nl_string spc_string };\nexport\nclosure main = main_p main_d;\nentry main;\n" }, { "path": "tests-old/pzt/temperature.exp", "content": "0 degrees celcius is 32 degrees farrenheit.\n-40 degrees celcius is -40 degrees farrenheit.\n37 degrees celcius is 98 degrees farrenheit.\n" }, { "path": "tests-old/pzt/temperature.pzt", "content": "// Temperature conversion example\n\n// This example demonstrates some arithmatic.\n\n// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule temperature;\n\nimport Builtin.print (ptr - );\nimport Builtin.int_to_string (w - ptr);\n\nproc c_to_f (w - w) {\n 9 mul 5 div 32 add ret\n};\n\nproc print_int (w -) {\n call Builtin.int_to_string call Builtin.print ret\n};\n\nproc print_c_to_f (w w -) {\n // do this with swap to Builtin.print C first\n swap\n call print_int get_env load main_s 1:ptr drop call Builtin.print\n call print_int get_env load main_s 2:ptr drop call Builtin.print\n ret\n};\n\nproc do_c_to_f (w -) {\n dup call c_to_f tcall print_c_to_f\n};\n\nproc main_p (- w) {\n 0 call do_c_to_f\n -40 call do_c_to_f\n 37 call do_c_to_f\n 0 ret\n};\n\ndata c_is_string = string {32 100 101 103 114 101 101 115 32 99 101 108\n 99 105 117 115 32 105 115 32};\ndata f_string = string {32 100 101 103 114 101 101 115 32 102 97 114\n 114 101 110 104 101 105 116 46 10};\nstruct main_s { ptr ptr };\ndata main_d = main_s { c_is_string f_string };\n\nexport\nclosure main = main_p main_d;\nentry main;\n" }, { "path": "tests-old/pzt/trunc_ze_se.exp", "content": "1130\n106\n255\n-1\n-1\n65535\n18\n" }, { "path": "tests-old/pzt/trunc_ze_se.pzt", "content": "// This is free and unencumbered software released into the public domain.\n// See ../LICENSE.unlicense\n\nmodule trunc_ze_se;\n\nimport Builtin.print (ptr - );\nimport Builtin.int_to_string (w - ptr);\n\nproc print_int (w -) {\n call Builtin.int_to_string call Builtin.print\n get_env load main_s 1:ptr drop\n call Builtin.print ret\n};\n\nproc main_p ( - w) {\n 66666 trunc:w:w16 ze:w16:w call print_int\n 66666 trunc:w:w8 ze:w8:w call print_int\n 255:w8 ze:w8:w call print_int\n 255:w8 se:w8:w call print_int\n 255:w8 se:w8:w16 se:w16:w call print_int\n 255:w8 se:w8:w16 ze:w16:w call print_int\n 254:w8 20:w8 add:w8 ze:w8:w call print_int\n 0 ret\n};\n\ndata nl = string { 10 0 };\nstruct main_s { ptr };\ndata main_d = main_s { nl };\n\nexport\nclosure main = main_p main_d;\nentry main;\n" }, { "path": "tests-old/run_tests.sh", "content": "#!/bin/sh\n#\n# This is free and unencumbered software released into the public domain.\n# See ../LICENSE.unlicense\n#\n# vim: noet sw=4 ts=4\n#\n\nset -e\n\nNUM_TESTS=0\nNUM_SUCCESSES=0\nFAILURE=0\nTESTS=\"\"\nFAILING_TESTS=\"\"\nWORKING_DIR=$(pwd)\nTEST_GROUP=$1\nif [ \"$CI\" = \"true\" ]; then\n LONG_OUTPUT=1\nelse\n LONG_OUTPUT=0\nfi\n\nwhich tput > /dev/null\nif [ $? -a \"$TERM\" != \"\" ]; then\n if [ 8 -le \"$(tput colors)\" ]; then\n TTY_TEST_SUCC=$(tput setaf 2)$(tput bold)\n TTY_TEST_FAIL=$(tput setaf 1)$(tput bold)\n TTY_RST=$(tput sgr0)\n fi\nfi\n\nfor EXPFILE in pzt/*.exp; do\n if [ -f \"$EXPFILE\" ]; then\n TESTS=\"$TESTS ${EXPFILE%.exp}\"\n fi\ndone\n\n# plzbuild/ninja won't rebuild things if the compiler binaries change, so\n# make sure it rebuilds things and regenerates the ninja files\n#\n# However touching the build files won't update ninja.rules, instead remove\n# all the _build directories.\n\nSTALE_BUILD_DIRS=$(find . -name _build -type d)\nif [ -n \"$STALE_BUILD_DIRS\" ]; then\n rm -r $STALE_BUILD_DIRS\nfi\n\nDIRS=\"modules-invalid\"\n\nfor DIR in $DIRS; do\n for EXPFILE in $DIR/*.exp; do\n if [ -f \"$EXPFILE\" ]; then\n TESTS=\"$TESTS ${EXPFILE%.exp}\"\n fi\n done\n for EXPFILE in $DIR/*.expish; do\n if [ -f \"$EXPFILE\" ]; then\n TESTS=\"$TESTS ${EXPFILE%.expish}\"\n fi\n done\ndone\n\nfor TEST in $TESTS; do\n NAME=$(basename $TEST .test)\n DIR=$(dirname $TEST)\n # Wrapping this up in a test and negating it is a bit annoying, but it\n # was the easy way I could redirect the output and errors successfully.\n\n case \"$TEST_GROUP\" in\n rel)\n if [ $TEST = valid/allocateLots ]; then\n continue\n fi\n ;;\n gc)\n case \"$TEST\" in\n valid/die|valid/noentry)\n continue\n ;;\n *invalid/*|../examples/*)\n continue\n ;;\n esac\n ;;\n esac\n\n cd $DIR\n if [ \"$LONG_OUTPUT\" = \"1\" ]; then\n echo -n \"$DIR/$NAME...\"\n fi\n\n if [ \"$TEST_GROUP\" = \"gc\" ]; then\n TARGET_TYPE=gctest\n else\n TARGET_TYPE=test\n fi\n\n trap 'echo; echo Interrupted $DIR/$NAME; exit 1' INT\n if make \"$NAME.$TARGET_TYPE\" >\"$NAME.log\" 2>&1; then\n if [ \"$LONG_OUTPUT\" = \"1\" ]; then\n printf \"%s pass%s\" \"$TTY_TEST_SUCC\" \"$TTY_RST\"\n else\n printf '%s.%s' \"$TTY_TEST_SUCC\" \"$TTY_RST\"\n fi\n NUM_SUCCESSES=$(($NUM_SUCCESSES + 1))\n else\n if [ \"$LONG_OUTPUT\" = \"1\" ]; then\n printf \"%s fail%s\" \"$TTY_TEST_FAIL\" \"$TTY_RST\"\n else\n printf '%s*%s' \"$TTY_TEST_FAIL\" \"$TTY_RST\"\n fi\n FAILURE=1\n FAILING_TESTS=\"$FAILING_TESTS $TEST\"\n fi\n trap - INT\n\n if [ \"$LONG_OUTPUT\" = \"1\" ]; then\n printf '\\n'\n fi\n cd $WORKING_DIR\n NUM_TESTS=$(($NUM_TESTS + 1))\ndone\nprintf '\\n'\n\nif [ $FAILURE -eq 0 ]; then\n printf '%sAll %d tests passed %s\\n' \"$TTY_TEST_SUCC\" \"$NUM_TESTS\" \"$TTY_RST\"\nelse\n NUM_FAILED=$(( $NUM_TESTS - $NUM_SUCCESSES ))\n printf '%d out of %d passed, ' \"$NUM_SUCCESSES\" \"$NUM_TESTS\"\n printf '%s%d failed%s\\n' \"$TTY_TEST_FAIL\" \"$NUM_FAILED\" \"$TTY_RST\"\n\n printf 'Failing tests: \\n\\t%s\\n' \"$(echo $FAILING_TESTS | sed -e 's/ /\\n\\t/g')\"\nfi\n\nexit $FAILURE\n" } ]